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INTRODUCTION 


This  listing  of  EOSAEL  80-B  is  a  supplement  to  Volume  11^  and  supersedes  all 
previous  listings.^  The  current  listing  is  complete  as  of  8  February  1982  and 
has  revisions  one  through  five  incorporated  into  it. 

EOSAEL  80-B  differs  from  EOSAEL  80  in  that  modules  SPOT,  LT4M,  NMMW,  CLIMAT, 
BASCAT,  and  TURB  have  been  extensively  revised  and,  therefore,  appear  with  new 
sequence  numbers.  All  other  modules  have  their  original  sequencing,  except 
where  revisions  have  been  inserted  or  deleted. 

The  programs  are  listed  by  module  with  each  module  followed  by  its 
subroutines.  Subroutines  that  have  been  listed  for  prior  modules  in  the 
listing  are  not  repeated  in  the  source  listing.  The  table  of  contents  lists 
each  module  along  with  all  its  corresponding  subroutines  and  the  page  number 
of  each  subroutine  in  the  listing.  The  elements  EOMAIN,  COMPLT,  and  RESET, 
which  are  always  to  be  resident,  appear  only  at  the  beginning  of  the  table  of 
contents  and  the  source  listing. 

Also  included  herein  is  a  sample  input  file,  MEWRUN,  and  an  output  file, 
EOOUT,  produced  by  using  the  aforementioned  sample  input  file. 

The  supplemental  codes  AGAUS  and  FLASH  are  supplied  with  EOSAEL  80.  FLASH  is 
described  in  appendix  A  of  volume  II  of  the  User's  Manual^  and  is  further 
described  in  the  comments  of  the  source  listing.  Operating  instructions  for 
the  AGAUS  code  may  be  found  in  the  comments  of  the  source  listing.  Manuals 
for  AGAUS  are  available  upon  written  request  from  the  US  Army  Atmospheric 
Sciences  Laboratory,  White  Sands  Missile  Range,  New  Mexico. 


‘Shirkey,  R.  C.,  and  S.  6.  O'Brien,  EOSAEL  80,  Volume  II,  User's  Manual. 
ASL-TR-0073,  US  Army  Atmospheric  Sciences  Laboratory,  White  sands  Missile 
Range,  NM,  1981. 

^Steinhoff,  R.  G. ,  Program  Listings  for  EOSAEL  80  and  Ancillary  Codes  ^AUS 
and  FLASH,  ASL-TR-0073  (Supplement),  US  Army  Atmospheric  Sciences  Laboratory, 
White  Sands  Missile  Range,  NM,  1981. 
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PROuR^iM  EOSAEL 

MhIN  program  for  EOSAEL  80  EOMOOOtO 

EOMuCi020 

REAL  L0TRNSAAZTRN,L2TRN,MMTftAN,MMWTRN. IPNAM, lAL, IALB1 , IALB2  EOM00030 

LOGICAL  ISP0T,N16,L0READ  EOM00040 

COMMON  <^SP0TL0/ISPCT,L0READ,N16  EOM00050 

COMMON  /'C0NST/'P1,PI2,P1RAD,TU0PI.T0RRMB,CC’EGK  EOM00060 

COMMON  /CLYMAT/'TEMP,PRESS,RH, AH>DP, V1S,CLDAMT,CLDHYT,F0GPRB,  EOM00070 

1  UNDVEL,UINDDIR,  IPASCT  EOM00080 

COMMON  /lOUNlT/'IOIN, lOOUT, IPHFUN . LOUNI T , ND IRTU , NCL I MT , KSTOR , NPLOTUEOMO 009 0 


COMMON  /GEOMET/'PTS<  15  ),  IGEOSW 
lOIN  -  CARD  READER 
lOOUT  -  PRINTER 

IPHFUN  -  UNIT  UPON  WHICH  PHASE  FUNCTION  DATA  RESIDES 
LOUNIT  -  UNIT  UPON  WHICH  LT4M  ATM  DATA  RESIDES 
NDIRTU  -  UNIT  UPON  WHICH  DRTRAN  DATA  RESIDES 
NCLIMT  -  UNIT  FOR  CLIMATOLOGICAL  DATA 
KSTOR  -  AUNILLARY  START/RESTART  UNIT  FOR  BASCAT 
NPLOTLi  -  OPTIONAL  UNIT  FOR  WRITING  RtSULTS  FOR  SUBSEQUtNT 
PLOTTING  PURPOSES  BY  THE  USER, 

DIMENSION  TPAN(  1 6  >, RADA<  i 6  >,RADG< 16  >, IPROGNI 20  > 

DIMENSION  IDOPGMf  20  IPNAM<  40 ) 

DIMENSION  IAL< 12),DAT< 1 0) 

FOR  UN  I VAC 

DATA  luIN,  lOOUT,  IPHFUN,  LOUNIT,  NDIRTU, NCLIMT,  KSTOR.-' 

1  5,6,3,8,7,24,25,' 

PROGRAM  NAMES 

DATA  IPNAM/4HSP0T, 4HTUR6, 4HeASC, 4HLT4M, 4HXSCA, 4HSM0K, 4HDRTR, 

1  4HL2TR,4HNMMW,4HCLTR,4HSCRE,4HFCL0,4H0VRC,4HGRNA,4H* 

2  4H*  ,4H*  ,4H*  ,  4H>f  ,4HCLIM,4H  ,  4H  ,  4HAT 

3  4H  ,4HLE  ,4HE  , 4HAN  ,4HAN  , 4H  , 4HAN  , 4HEN  , 

4  4HUD  ,4HST  ,4HDE  , 4H  , 4H  ,4H  , 4H  , 4H 

5  4HATE  / 

CARD  MNEMONICS 

DATA  IAL/’4HE0RU,4HVIS  ,  4HFREQ ,  4HWAVL, 4HUVNiJ,  4HRE3F , 
14HTARG,4HRCVR, 4HDESG,4H0BSV,4HBFCL,4HG0  / 

DATA  PI,TORRMe,CDEGK/’3. 14159265,  1 .33322,273. 16/ 

DATA  PTS,'15>fO.  0/ 

ISTART=0 

CLDAMT=0, 

CLDHYT=0. 

FOGPRB=0, 

PI2=Pl/2. 

PIRAD=PI/’180. 

TW0PI=2. 0*PI 
WRITE  < lOOUT, 1060> 


EOM001 00 
EOM001 1 0 
EOM00120 
EOM00130 
EOMOoi 40 
EOM00150 
EOMOOI 60 
EOMOOI 70 


EOMOOI 80 
EOM00190 
EOM00200 
EOr  0021 0 
tuh0022u 
EOM00230 
EOM00240 
EOM 00250 
EOM00260 
EOM00270 
EOM00280 
EOM 00290 
EOM00300 
EOM 0031 0 
EOM00320 
EOM00330 
EOM00340 
EOM90350 
EOH00360 
EOM00370 
EOM00380 
EOM 00390 
EOM00400 
EOM0041 0 
EOM00420 
EOM00430 


J /Q  ************ ’****EOMO  044  0 
C  EOM00450 
C**  INPUT  TO  EOSAEL  IS  CARD  ORDER-INDEPENDENT,  WITH  EACH  INPUT  RECORD  EOM00460 
C**  HAVING  A  FOUR-LETTER  IDENTIFIER  IN  COLUMNS  1-4.  THE  ONLY  EXCEPTION  EOM00470 
C=**  TO  THIS  RULE  IS  THE  GO  SENTINEL  CARO,  WHICH  MUST  BE  THE  LAST  RECORD  EOM00480 
C**  IN  THE  INPUT  SEQUENCE.  ALU  RECORDS  ARE  READ  IN  UNDER  THE  EOM00490 
C**  FORMAT  < 2A4, IX, 1 0E7 .4 >,  INTEGERS  MUST  BE  INPUT  AS  REAL  EuMOOSOO 
CXi*  NUMBERS  IN  THIS  COMMON  FORMAT  SCHEME,  THEY  ARE  LATER  FIXED  TO  EOM00510 
CX.X.  THE  INTEGER  TYPE.  THE  IDENTIFIERS  FOR  EACH  OF  THE  INPUT  EOM00520 
C**  RECORDS  ARE  AS  FOLLOWS  :  ECHO 0530 
C  EOMU0540 

C -  EOM00550 

C  CARD  IDENTIFIER  :  EORUN  EuMOOSbO 
C  VARIABLES  READ  :  NUMRUH  EOM 00570 
C  NUMRUN  -  NUMBER  OF  TIMES  EOSAEL  DRIVER  IS  TO  BE  CYCLED  EOM00580 
C  DEFAULT  IS  1 ,  EOM00590 

C -  EOMOObOO 

C  CARD  IDENTIFIER  :  VIS  EuM00610 
C  VARIABLES  READ  :  VIS,EXTH55,EXTH  EOM00620 
C  VIS  -  VISIBILITY  AT  WAVELENGTH  OF  0.55  MICRONS  <KM)  EOM00630 
C  EXTN55  -  EXTINCTION  COEFFICIENT  AT  0.55  MICRONS  <KM*x— 1>  EOM00640 
C  EXTN  -  EXTINCTION  COEFFICIENT  AT  INPUT  WAVELENGTH  <KH*x-1>  EOM00650 
C  **  NOTE  :  IF  THE  VIS  CARD  IS  NOT  INPUT,  A  WARNING  IS  PRINTED  EOM00660 
C  AND  THE  VISIBILITY  IS  SET  TO  A  DEFAULT  VALUE  OF  10  KM.  EOM00670 


^*SCSOWU  PjiOK  FILkH) 


C  **  NOTE  !  IF  EXTN55  IS  INPUT  rtS  A  VALUE  LESS  THAN  0.0001,  IT 
C  IS  SET  EQUAL  TO  THE  QUOTIENT  3,912,^VIS.  IF  VIS  IS 

C  INPUT  AS  A  VALUE  LESS  THAN  O.OOOt,  IT  IS  SET  EQUAL  TO 

C  THE  QUOTIENT  3 . 9 1 2/EXTN55 . 

C  NOTE  :  EXTN  IS  NEEDED  ONLY  FOR  BASCAT 

C - 

C**  ONLY  ONE  OF  THE  FOLLOWING  THREE  CARDS  MAY  BE  INPUT  FOR  A  GIVEN 
C**  CYCLE  OF  EOSAEL.  IF  NONE  OF  THESE  CARDS  IS  PRESENT,  AN  ERROR 
C**  MESSAGE  IS  PRINTED  AND  EXECUTION  IS  TERMINATED, 

C 

C  CARD  IDENTIFIER  s  FREQ 

C  VARIABLES  READ  :  FREQ1 ,  FREQ2,  MULDV 
C  FRE01  -  LOWER  INPUT  FREQUENCY  < GHZ ) 

C  FREQ2  -  HIGHER  INPUT  FREQUENCY  < GHZ > 

C  MULDV  -  FREQUENCY  INCREMENT  FOR  SPOT  AND.-'OR  LT4M  f  GHZ  > 

C  CARD  IDENTIFIER  ;  WAVL 

C  VARIABLES  READ  s  WAVEl,  WAVE2,  MULDV 

C  WAVEl  -  SHORTER  INPUT  WAVELENGTH  <MICRONS> 

C  WAVE2  -  LONGER  INPUT  WAVELENGTH  < MICRONS) 

C  MULDV  -  WAVELENGTH  INCRhMENT  FOR  SPOT  AND/OR  LT4M  < MICRONS) 

C  CARD  IDENTIFIER  i  WVNUM 

C  VARIABLES  READ  :  WVNUM1,  WVNUM2,  MULDV 

C  WVNUM1  -  LOWER  INPUT  WAVENUMBER  <CM*»-1> 

C  WVNUM2  -  HIGHER  INPUT  WAVENUMBER  tCM^^-l  ) 

C  MULDV  -  WAVENUMBER  INCREMENT  FOR  SPOT  AND/OR  LT4M  ':CMt-H.-i> 

C - 

C 

C**  THE  NEXT  CARD  DETERMINES  WHETHER  A  SENSOR  RESPONSE  FUNCTION 
C**  IS  DESIRED  FOR  BROAD  BAND  CALCULATIONS.  THIS  OPTION  IS 
C**  INVOKED  ONLY  IF  THIS  CARD  IS  PRESENT. 

C 

C  CARD  IDENTIFIER  i  RESF 

C  VARIABLES  READ  :  NONE  HERE  -  SEE  SPOT  OR  LT4M  WRITEUP  FOR 
C  PROPER  PLACEMENT  OF  RESPONSE  FUN  CARDS, 

C - 

C 

C**  THE  NEXT  FIVE  CARDS  COMPRISE  THE  GEOMETRICAL  OPTION  OF  EOSAEL. 
C**  THIS  OPTION  IS  USEFUL  FOR  EOSAEL  RUNS  WHERE  SEVERAL  MODULES 
C**  EXAMINE  DIFFERENT  ATMOSPHERIC  OBSCURATION  EFFECTS  ALONG  THE 
C**  SAME  PHYSICAL  PATH.  THE  GEOMETRICAL  OPTION  ASSURES  THAT  THE 
C+f  POINTS  OF  REFERENCE  IN  THE  SCENARIO  UNDER  EXAMINATION  ARE 
C**  CONSISTENTLY  SPECIFIED  FOR  ALL  MODULES.  IT  SHOULD  BE  NOTED 
C**  THAT  THIS  OPTION  IS  ACTIVATED  WNENEVER  ANY  OF  THE  FIVE  CARDS  IS 
C**  ENCOUNTERED.  ONCE  THE  OPTION  IS  ACTIVATED  IT  IS  IMPORTANT  THAT 
C**  AT  LEAST  THE  FIRST  TWO  CARDS  < TARG  AND  RCVR )  BE  INPUT  TO 
C**  DEFINE  THE  PHYSICAL  PATH,  SINCE  THIS  OPTION  WILL  OVERRIDE 
C**  POSITIONS  OR  LENGTHS  CONTAINED  IN  NORMAL  INPUT  TO  ALL  MODULES. 
C=*‘»  THE  GEOMETRICAL  INPUT  CONSISTS  OF  FIVE  SETS  OF  COORDINATES 
C**  WHICH  OBEY  THE  FOLLOWING  CONVENTIONS  : 

C*»  -;A)  ALL  COORDINATES  ARE  DIMENSIONED  IN  KILOMETERS 

C  <B)  THE  2-AXIS  IS  POSITIVE  UPWARD 

C  <C)  THE  Y-AXIS  POINTS  NORTH 

C  <D)  THE  X-AXIS  POINTS  EAST 

C 

C**  THE  FIVE  GEOMETRICAL  CARDS  ARE  AS  FOLLOWS  : 

C 

C 

C  CARD  IDENTIFIER  ;  TARG 

C  VARIABLES  READ  :  PTS< 1  ), PTS< 2 ), PTS< 3 > 

C  PTS<1-3>  -  COORDINATES  OF  THE  TARGET  (FOR  THE  DRTRAN  MODULE, 

C  THESE  ARE  THE  COORDINATES  OF  THE  TRANSMITTER). 

C 

C  CARD  IDENTIFIER  ;  RCVR 

C  VARIABLES  READ  i  PTS< 4  ), PTS< 5  ) , PTS< 6 ) 

C  PTS<4-6)  -  COORDINATES  OF  THE  RECEIVER  OR  SEEKER 

C 


EOMOOSBO 
EOM00690 
EOMOOZOO 
EOM0071 0 
EOM 00720 
EOM00730 
EOM00740 
EON00750 
EOM00760 
EOM00770 
EOM007S0 
EOM00790 
EOM00800 
EOM 0081 0 
EOM00820 
EOM 00830 
EOM00840 
EOM 00850 
EOM00860 
EOM00870 
EOM00880 
EOM00890 
EOM00900 
EOM 0091 0 
EOM00920 
EOM00930 
EOM00940 
EOM00950 
EOM 00960 
EOM00970 
EOM00980 
EOM00990 
EOM01 000 
EOM01 01 0 
EGM01 020 
EOM01 030 
EOM01 040 
EOM01 050 
EOM01 060 
EOM 01 070 
EOM01 030 
EOM 01 090 
EOM01 1 00 
EOM01 1 1 0 
EOMOl 120 
EOM01 130 
EOM01140 
EOMOl 150 
EOMOl 160 
EOMOl 170 
EOMOl 180 
EOMOl 190 
EOM01200 
EOM0121 0 
EOM01220 
EOM01230 
EOM01240 
EOM01250 
EOM01260 
EOM01270 
EOM01280 
EOM0t290 
EOM01300 
EOM0131 0 
EOM01320 
EOM01330 
EOM01340 
EOM01350 
EOMOl 360 
EOM01370 
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0000000000000000000000000000000000000000000000000000000000000000000 


ChRD  identifier  !  DESG 

VARIABLES  READ  i  PTS< 7  ) . PTS< 8 > , PTS< 9 > 

PTS<7-9)  -  COORDINATES  OF  THE  DESIGNATOR  OR  SOURCE 

CARD  IDENTIFIER  :  OBSV 

VARIABLES  READ  :  PTS< 1 0 > . PTS< 1 1 > , PTS< 1 2 > 

PTS< 10-12)  -  COORDINATES  OF  THE  OBSERVER  USED  BY  DRTRAN 

CARD  IDENTIFIER  !  BFCL 

VARIABLES  READ  !  PTS< 1 3  ) , PTS< 1 4 ) . PTS< 1 5 > 

PTS< 13-15)  -  COORDINATES  OF  THE  CENTER  OF  THE  CLOUD  ELLIPSOID 
USED  BY  BASCAT  AND  FCLOUD 


+*  THE  NEXT  INPUT  CARD  IS  THE  CL IHATDLOGICAL  OPTION  CARD.  THIS 
+f  OPTION  ALLOWS  USER  INPUT  OF  METEOROLOGICAL  PARAMETERS  DIRECTLY 

+*  Ok  Automatic  input  of  climatology  data  cHARACTtRisTic  of 

**  WEST  GERMANY.  IF  THIS  OPTION  IS  INVOKED  ALL  MODULES  WILL  USE 
THIS  DATA,  I.E.  MET  DATA  THAT  HAS  BEEN  INPUT  TO  A  SPECIFIC 
-ft-  MODULE  WILL  BE  OVERRIDDEN, 


CARD  IDENTIFIER  s  CLIMAT 

VARIABLES  READ  ;  I CLMAT , LOCAT , MONTH , NHOUR , I W I ND , NPRT 

♦  f  OR  +>*■  ICLMAT,  IPASCT, TEMP,  PRESS,  RH,  AH,  DP,  VIS,  WNDVEL, 

WINDDIR 

LOCAT  -  CLIMATOLOGY  REGION  INDICATOR.  LuCAT  Is  AN  INTEGER 
<1-4>  FOR  CENTRAL  EUROPE  AND 
<5-iO)  FOR  MID-EAST. 

L  =  1  -  EUROPEAN  LOWLANDS, 

L  =  2  -  EUROPEAN  RHINE  VALLEY, 

L  =»  3  -  EUROPEAN  HIGHLANDS, 

L  =  4  -  EUROPEAN  ALPINE, 

L  =  5  -  MIDEAST  DESERTS, 

L  *  6  -  MIDEAST  COASTAL, 

L  “  7  -  MIDEAST  PERSIAN  GULF, 

L  «=  8  -  MIDEAST  RED  SEA, 

L  «  9  -  MIDEAST  EASTERN  MOUNTAINS,  AND 
L  *  10  -  MIDEAST  INDUS  VALLEY. 


EOM01 380 
EOM01 390 
EOM01400 
EOM0141 0 
EOM01420 
EOM01430 
EOM01440 
EOM01450 
EOM01460 
EOM01470 
EOM01480 
EOM01 490 
EOM01 500 
EOM0151 0 
EOM01 520 
EOM01530 
EOM01 540 
EOM01 550 
EOM  01560 
EOMO I  570 
EOnOISaO 
EOM01 590 
EOMO 1 600 
EOM01 61 0 
EOM Li  62  0 
EOM01630 


MONTH  -  AN  INTEGER  <1-12)  INDICATING  THE  MONTH  OF  THE  YEAR. 

MONTH  IS  USED  TO  SELECT  THE  SEASON  WHICH  IS 
APPLICABLE  TO  THE  REGION  LOCAT. 

NHOLIR  -  AN  INTEGER  <0-23)  INDICATING  THE  TIME  OF  DAY  LOCAL 

STANDARD  TIME  < LST ) .  NHOUR  IS  USED  TO  SELECT  ONE  OF 
FOUR  TIME  PERIODS  OF  THE  DAY  20-02,  03-09,  10-14, 

AND  15-19. 

IWIND  -  NOT  USED 
NPRT  -  A  PRINT  SELECTOR. 

NPRT  LE  ZERO  -  DO  NOT  PRINT  CLIMATOLOGICAL  DATA. 

NPRT  GT  ZERO  -  PRINT  ALL  AVAILABLE  MEANS,  STANDARD 
DEVIATIONS,  AND  PERCENT  OCCURRENCES. 

ICLMAT  »  2.:  USER  INPUT  QUANTITIES  EOM01820 

IPASCT  =  PASQUILL  STABILITY  CATEGORY  VALID  RANGE  =1 . -6 . < A-F  )EOM01 830 
TEMP  =  TEMPERATURE  IN  DEGREES  C  EOM01840 

PRESS  -  PRESSURE  IN  MB  < SEA  LEVEL  IF  ICLMAT=1  >  EOM01850 

RH  =  RELATIVE  HUMIDITY  IN  X  EOM0t860 

AH  =  ABSOLUTE  HUMIDITY  -  DEFINED  HERE  AS  THE  H20  VAPOR  EOM01870 

DENSITY  IN  G/M-**3.  EOM01880 

DP  =  DEW  POINT  TEMPERATURE  IN  DEGREES  C  E0M01S90 

VIS  =  VISIBILITY  IH  KM  EOM01900 

UNDVEL  =  WIND  VELOCITY  IN  M/S  <DEPNT  UPON  IWIND  IF  ICLMAT=1 >£OMOi 91 0 

WINDIR  =  WIND  DIRECTION  IN  DEGREES  < IF  ICLMAT=1  WILL  BE  EOM01920 

HOST  PROBABLE  DIRECTION)  EOH01930 

-  EOM01940 

EOM01950 

C>**  THE  FOLLOWING  CARDS  ARE  ALSO  READ  IN  UNDER  THE  COMMON  FORMAT  EOM01960 

C**  USED  ABOVE.  THE  INFORMATION  ON  EACH  OF  THESE  RECORDS  DETERMINES  EOM01970 

C-**  WHICH  MODULES  ARE  SELECTED  AND  HOW  MANY  TIMES  THE  MODULES  ARE  EOM01980 


000000000000000000000000000000000 


TO  BE  CYCLED  WITHIN  EACH  CYCLE  OF  THE  EOSAEL  DRIVER, 

CARD  IDENTIFIER  ;  < SEE  MODULE  IDENTIFIERS  BELOW) 

VARIABLES  READ  ;  IDOFGM 

IDOPGM  -  NUMBER  OF  TIMES  THE  SELECTED  MODULE  IS  TO 

BE  CYCLED  WITHIN  EACH  EOSAEL  CYCLE  -  DEFAULT  IS  ONE. 


MODULE  IDENTIFIER 


WAVE<UH) 


RANGES 


FREQ<  GHZ  ) 


EOM01990 
EOM02000 
EOM0201 0 
EOM02020 
EOM02030 
EOM02040 
EOM02Ci30 
EOM02060 
EOM02070 
EOM02080 
EOM02090 


1 

SPOT 

.25-2. ,3.-5. ,8.-12.  ♦ 

EOM021 00 

2 

TURB 

LT  14.  * 

EOM021 1 0 

3 

BASCAT 

ANY  WAVELENGTH  IN  DATA 

FILE 

IPHFUN 

EOM02I20 

4 

LT4pl 

EOMOZI 30 

5 

XSCALE 

1 . 06,3-5,8-12  * 

EOM02140 

6 

SMOKE 

,4-1 .2,3-5,8-12  * 

94  . 

EOM02150 

7 

DRTRAN 

.4-1  .1 ,3.5-4 . ,8 . 5-1 2 

94.-140. 

EOM02160 

8 

LZTRAN 

.8-11.  * 

EOM02170 

9 

NMMW 

♦ 

1 0-350 

EOM02180 

1  0 

CLTRAN 

. 2-2 . ,3.-5. ,8. -12. ♦ 

EOM02i90 

1 1 

SCREEN 

N/A 

EOM02200 

12 

FCLOUD 

ANY  WAVELENGTH  IN  DATA 

FILE 

IPHFUN 

EOM0221 0 

13 

OVRCST 

ANY  WAVELENGTH 

EOM02220 

14 

GRNADE 

SAME  AS  SMOKE 

EOM02230 

**  NOTE  !  THE  DATA  SPECIFIC  TO  EACH  MODULE  MUST  BE  INPUT  IN  EOM02240 

THE  SEQUENCE  IN  THE  ABOVE  LIST.  EOM02230 

-  EOM 02260 

CARD  IDENTIFIER  !  GO  EOM02270 

VARIABLES  READ  s  NONE  EOM02280 

END  OF  READ  SENTINEL  <MUST  BE  LAST  CARD  READ).  EOM02290 

EOM02300 

NUMRUH=1  EOM02320 

IRFLAG=0  EOM02330 

READ  <  lOIN,  1  000  )  I  ALB  1 , I ALB2, < DAT< L >, L-1 ,  1  0 >  EOM02340 

IF  < IALB1 .NE . IAL< 1 ))  GO  TO  10  EOM02350 

NUMRUH'=IFIX<OAT<  1  )>  EOM02360 

IF  <NUMRUN.eO. 0)  NUMRUN=1  EOM02370 

GO  TO  20  EOM02380 

C  SET  FLAG  IF  EORUN  IS  NOT  THE  FIRST  CARD  EOM02390 

10  IRFLAG=1  EOM02400 

20  CONTINUE  EOM02410 

DO  580  JRUN=1 . NUMRUN  EOM02420 

C  INITIALIZATION  EOM02430 

DO  30  I«1,20  EOM02440 

C  PROGRAM  SELECTOR  EOM02450 

IPROGN<I)=0  EOM02460 

C  PROGRAM  CYCLE  DEFAULT  EOM02470 

30  ID0PGM<I)s1  EOM02480 

C  TRANSMISSIONS  EOM02490 

L0TRNS=1 .  EOM02500 

XSTRN=1,  EOM02510 

SMKTRN=1 .  EOM02520 

DRTRN=«1  ,  EOH02530 

LZTRN=1.  EOM02540 

MMWTRN=1 .  EOM02550 

CLTRN=1.0  EOM02560 

GRNTRN>:1.0  EOM02570 

IF  <JRUN,GT.1)  WRITE  <IOOUT,1070>  JRUN  EOM02580 

C  FREQUENCY,  WAVELENGTH,  WAVENUMBER  INDICATOR  EOM02590 

IFW^O  EOM02600 

C  GEOMETRICAL  OPTION  SWITCH  EOM02610 

ICEOSW=0  EOM02620 

C  SENSOR  RESPONSE  FUNCTION  OPTION  SWITCH  EOM02630 

NR=0  EOM02640 

VIS=>0.0  EOM02650 

EXTN55=>0.0  EOM02660 

EXTN-0.0  EGH02670 

DO  220  J-1,25  EOM02680 
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IF  (IRFLnG.EQ.I >  WRITE  <IOGUT,104u>  EuH02b90 

SUPRESS  READ  IN  CASE  FIRST  CARD  PREVIOUSLY  READ  WASNT  EORUN .  E0n02700 

IF  < IkFLAG .EQ. 0)  READ  <I01H,100u>  I ALBI , I ALB2 A DATt L >, L= 1 , 1 0  )  EuM02710 

IRFLAG=0  EOM02720 

INOPT=0  EOH02730 

IF  <J,ECi,25)  GO  TO  230  EOK02740 

DO  40  Kk=l ,12  EOM02750 

CHECK  FOR  CARD  TYPES,  NOT  PROGRAM  SELECTOR  EOM0276O 

IF  < IALB1 .NE.IAL<KK)>  GO  TO  40  E0M02770 

INOPT=KK  EOM02780 

IF  < IH0PT.GE.3.AND. lNuPT,LE.5>  IFU=INuPT  EOM02790 

GO  CARD  FOUND  EOM02800 

IF  < INOPT . EO . 1 2 >  GO  TO  250  EOM02810 

GO  TO  SO  EOM 02820 

continue  EOM02S50 

SEARCH  FOR  PROGRAMS  HERE  EOM02840 

DO  50  KK<=1,20  EOM02850 

IF  < IALB1  . NE . IPNAM<KK >  )  GO  TO  50  EOM02860 

IPROGN< KK >=KK  EOMu2S70 

IF  <DAT< 1  >.GT. 1 . 0)  IDOPGM<KK>=IFIX<DAT< 1 >>  EOM02880 

IF  <KK.EG(.20)  GO  TO  60  EOM02890 

GO  TO  220  EOM02900 

CONTINUE  EOM02940 

GO  TO  240  EOM  2920 

CLIMATOLOGICAL  OPTION  INVOKED  EOM02930 

ICLMAT=IFIX<  DAT< 1  ) )  EOM02940 

IF  <  ICLMAT.EQ.2)  GO  TO  70  EOM02950 

L0CAT=IFIX<DAT<2 ))  EOM02960 

M0NTH=IFIX<DAT<3;;  EOM02970 

NH0UR=IFIX<DAT<4 >)  EOM02980 

IUIND=iFIX<DAT<5))  EOM02990 

NPRT=IFIX<DAT<6>>  EOMOSOOO 

GO  TO  220  EuHu3u4u 

IPASCT=«IFIX<DAT<2)>  EOM03020 

TEMP=DAT<3>  EOM03030 

PRESS=DAT<4>  EOM03040 

RH=DAT<5>  EOM03050 

AH=DAT<6)  EOM03060 

DP=DAT<7)  EOM03070 

VIS=DAT<8)  EOM03080 

WNDVEL=DAT<9)  EOM03090 

UNDDIR*=DAT<  1  0  )  EOM03J00 

GO  TO  220  EOM031 1 0 

GEOMETRICAL  OPTION  INVOKED  EOM03120 

IF  <  INOPT.GT.6)  GO  TO  90  EOM03t30 

CARD  SETUP  SWITCHING  EOM03140 

GO  TO  <21 0, 160, 170, 180, 190,200), INOPT  EOM03150 

LPTSSW=IN0PT-6  EOM03160 

IGE03U=1  EOM03t70 

DO  150  K=1 ,3  EOM03180 

GO  TO  <100,110,120,130,140),LPTSSW  EOM03190 

PTS<K)=DAT<K)  EOM03200 

GO  To  150  EOHO,5£'1  0 

PTS<K+3)=0AT<K)  EOM03220 

GO  TO  150  EuM0323u 

PTS<K+6)=DAT<K>  EOM03240 

GO  TO  150  EOM03250 

PTS<K+9)=DAT<K)  EOM03260 

GO  TO  150  EOH03270 

PTS<K+12>=DAT<K>  EOM03280 

CONTINUE  EOM03290 

GO  TO  220  EOM03300 

VISIBILITY  CARD  EOM03310 

VIS=DAT< 1 >  EOM03320 

EXTN55=>DAT<  2  )  EOM03330 

EXTN=DAT<3)  EOM03340 

GO  TO  220  EOM03350 

FREQUENCY  CARD  EOM03360 

FREQ1=DAT< 1 )  EOM03370 

FREQ2=DAT<2)  EOM03380 
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muldv=ifix<:dat<3)> 

GO  TO  220 

C  WAVELENGTH  CARD 
180  WAVEt»DAT<t) 

WAVE2-DAT<2> 

MULDV»IFIX<DAT<3>> 

CO  TO  220 

C  WAVENUMBER  CARD 

190  WVNUM1-OAT< 1 > 

WVNUM2-DAT<2> 

MULDV=IFIX<DAT<3;> 

GO  TO  220 

C  SENSOR  OPTION  INVOKED 

200  NR=1 

GO  TO  220 

21  0  WRITE  < lOOUT, 1 01 0> 

220  CONTINUE 

IF  < IFW.NE. 0)  GO  TO  250 

C  ERROR  CHECK  ON  WAVENUMBER,  WAVELENGTH,  OR  FREQUENCV 

WRITE  C lOOUT,  1  02  0  ) 

GO  TO  580 

230  WRITE  < lOOUT, 1 030) 

GO  TO  250 

C  UNKNOWN  CARD  TYPE 

240  WRITE  <IOOUT,1040)  IALB1,IALB2 

250  CONTINUE 

C  SELECT  FREQUENCY,  WAVELENGTH,  OR  WAVENUMBER 

IF  < IFW-4)  260,270,280 
260  WVNUM1=FREQ1/30. 

UVNUM2=FREQ2730. 

UAVE1=0. 

IF  <FREQ2.GT. . 0001 )  WAVEI »3 . E+ 05/FREQ2 
WAVE2*3.E+05/'FREQ1 
GO  TO  290 
270  UVNUM1=0. 

IF  <WAVE2.GT. . 0001 )  WVNUM1 «1 . E+04/WAVE2 

WVNUM2=1 .E+04/WAVE1 

FRECI1=30,>*WVNUM1 

FREQ2=30.fWVNUM2 

GO  TO  290 

280  FREei=30  .■►WVNUM1 
FREQ2=30 .♦WVNUM2 
UAVE1=0. 

IF  <WVNUM2.GT,  . 0001 )  WAVE  1 =I , E+04/WVNOM2 
WAVE2=1  .E+04/‘WVNUM1 
290  CONTINUE 

IF  <VIS.LT. . 0001 .AND. EXTN55.lt. 0001 )  WRITE  <IOOUT,1050> 

IF  <VIS,LT.  .0001  .AND. EXTN55.lt. 0001  )  VIS-10. 

IF  <EXTN55.GT, . 0001 )  VIS-3 . 9127EXTN55 
IF  <VIS.GT. . 0001 >  EXTN55-3.912/VIS 
C  OUTPUT  INFORMATION 

WRITE  < lOOUT, 1 080) 

DO  300  1-1,20 

300  IF  < 1PR0GN< I ).EO. I )  WRITE  <IOOUT,1090)  IPNAM< I >, IPNAM< I+20 > 
WRITE  <IOOUT,1100)  WVNUM 1 , WVNUM2, WAVE1 , WAVE2 , FREQ  1 , FREQ2 
C  CLIMAT  USES  UNIT  NCLIMT 

IF  < ICLMAT.EQ. 1 >  CALL  CLIMAT<LOCAT, MONTH, HHOUR, IWIND,NPRT, TEMP 
1  PRESS,RH, AH,OP,VIS,WNDVEL,WNDDIR, IPASCT) 

WRITE  < lOOUT, 1110)  VIS 
IF  < ICLMAT.EQ. 2)  lCLMAT-1 

C*********m**ii**m'»*‘ti  SPOT  CONTRAST  PGM  *m*m'¥mm**********mm*’*‘*<*<¥>¥**** 

IF  < IPROGN< 1 >.NE. 1 >  GO  TO  320 
IPGM1=IDOPGM< 1  ) 

WRITE  < lOOUT, 1130) 

DO  31 0  1-1 , IPGMI 

C  SPOT  USES  UNITS:  IPHFUN  -  PHASE  FUNCTION;  LOUNIT  -  LT4M  DATA 

310  CALL  SPOT<WVNUM1 ,WVNUM2,VIS,NR, 1ERR,HULDV> 

CALL  RESET<IERR) 

C***<»««i»*i****«i«i.*4i4t*i*  TURBULENCE  PGM 
320  IF  < 1PR0CN<2).NE.2>  GO  TO  340 


EOM03390 
EOM03400 
EUM0341 0 
EOM03420 
EOMo3430 
EOM03440 
EQM03450 
EOM03460 
EOM03470 
EOM03480 
EQM03490 
EOM03500 
EOM0351 0 
EOM03520 
EOM03530 
EOM0354C 
EOM03550 
EOM03560 
E£iiM03570 
EOM03580 
EOM03590 
EuMD3600 
EOM036t  0 
EOMCi3620 
EOM03b30 
EOM03640 
EOMC3650 
EOM03660 
EOM03670 
EOM03680 
EOM03690 
EOM03700 
EOM037i 0 
EOM03720 
EOM03730 
EOM03740 
EOM03750 
EOM03760 
E0M03770 
EOM 03780 
EOM03790 
EOM03800 
EOM 0381 0 
EOM 03820 
EOM03d30 
EOM03840 
EOM038S0 
EOM03860 
EOM03870 
EOM03680 
EOM03890 
EOM03900 
EOM0391 0 
EOM03920 
E0M03930 
EOM03940 
EOM03950 
EOM03960 
EOM03970 
E0M03980 
'EGM03990 
EOM04000 
EOM0401 0 
EOM04020 
EOM04030 
EOM 04 040 
EOM040S0 
EOM04060 
EOM 04070 
EOM04080 
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IPGri2=I&0PGMc2  ) 

WRITE  < lOOUT, 1140) 

DO  330  1=1 , IPGM2 
330  CALL  TURB< WAVE1 , lERR  ) 

CALL  RESET<IERR> 

laser  multiple  scattering  PGM 
340  IF  < IPR0GN<3>,NE.3)  GO  TO  360 
IPGM3=ID0PGM<3> 

ISPOT=. FALSE. 

WRITE  < lOOUT, 1 150) 

DO  350  1=1 , 1PGM3 

C  BASCAT  USES  UNIT  IPHFUH  FOR  PHASE  FUNCTION 

350  CALL  BAbCAT< WAvEI , EXTN, lERR  ) 

CALL  RESET<IERR) 


LT4M  PGM 
36  0  IF  < IPROGN< 4  )  . NE . 4  )  GO  TO 


EOMu4090 
EOM041 00 
EOM041 1 0 
EOM04120 
EOM04130 

EOM04150 
EOM04160 
EOM04 170 
EOM04180 
EOM04190 

DATA  EOM04200 

EOM0421 0 
EOM04220 


380  EOM04240 


370 


LT4M  READS  ATM  DATA  FROM  LOUNIT 
ISPOT=, FALSE. 

LOREAD= . TRUE . 

IPGM4=I00PGM<4> 

DO  370  1=1 , IPGM4 

CALL  LT4M<H1 ,H2, ANGLE, ITYPE, IXY, TRAN , RADA , RADG , lEMlSS, 
1  VIS,UVNUM1 ,WVNUM2,T1 , ICLMAT , I  ERR, NR, IHAZE.MULDV) 

LOTRHS=LOTRNSfTRAN< 1  ) 

CALL  RESET<IERR) 


C >*' *■*>•> ♦"tn*'********'***'*  XSCALE  EXTINCTION  PGM 
380  IF  < IPR0GN<5),HE,5)  GO  TO  400 
WRITE  < lOOUT, 1160) 

IPGM5=1D0PGM<5) 

DO  390  1=1 , IPGM5 


EOM04250 
EOM04260 
EOM04270 
EOM04280 
EOM04290 
LEN, MODEL, EOM043 00 
EOM0431 0 
EOM04320 
EOM  1.4330 


i*4i«,tm<witii«i»«4i*«i«iW**iti4i««siii<>»>«i«>»i<«i<«iEOM04340 

EOM 04350 
EOM04360 
EOM04370 
EOM04380 

0.  ) 


CALL  XSCALE<WAVE1 ,VIS,EXTN55,XTRN, lERR, 0, 0, 0. , 0. >  EOM04390 

390  XSTRN=XSTRN*XTRN  EOM04400 

CALL  RESET< lERR )  EOM04410 

SMOKE  PGM  •ti*>*n**iiitmi4>*Hi**i**‘t>**‘('*=‘»4**'*'*‘*”**>i>***'***>***'*EOM 0442 0 
400  IF  < IPROCNi 6  ) . NE . 6 )  GO  TO  420  EOMC4430 

WRITE  < lOOUT, 1 170)  EOM04440 

IPGM6=ID0PGM<6)  EOM04450 

DO  410  N=1,IPGM6  EOM04460 

CALL  SMOKE<UAVE1 , ICLMAT, STRANS, lERR)  EOM04470 

410  SMK.TRN=SMKTRN>*.STRANS  EOM04480 

CALL  RESET< lERR)  EOM04490 

DRTRAN  PGM  ■•■4<>«<>l>*4i>»**4i4<ti*>*<*><'%>k4<«'it<<t"«<>|i>K’t>*«>*>#>t'>|i*i4i4i>|i4t>|i>*iEOM04500 

420  IF  < IPR0GN<7).NE.7)  GO  TO  440  EOM04510 

WRITE  < lOOUT, 1 180)  EOM04520 

IPGM7»ID0PGM<7)  EOM04530 

HOLDUV=WAVE1  EOM04540 

IF  <IFW  .EQ.I)  WAVE1=WAVE2  EOM 04550 

DO  430  N=1,IPGM7  EOM04560 

C  DRTRAN  USES  NDIRTU  FOR  DATA  EOM04570 

IF  <N.GT.1)  WRITE  <IOOUT,1120>  EOM04580 

CALL  ORTRAN<UAVE1 , ICLMAT, TRNLOS, lERR)  EOM04590 

430  DRTRN=DRTRN*TRNLOS  EOM04600 

WAVE1=HOLDWV  EOM04610 

CALL  RESET< lERR)  EOM04620 

LASER  TRANSMISSION  PGM  >**:***i(n**=i»i**n<*>n>»>inin»*nii*i*>»>**»i>*EOM 04630 
440  IF  < 1PR0GN<8),NE.8)  GO  TO  460  EOM04640 

WRITE  <IOOUT,fl90)  EOM04630 

IPCM8=ID0PGM<8)  EOM04660 

DO  450  I=1,IPGH8  EOM04670 

CALL  L2TRAN< WAVE  1 , ICLMAT, LAZTRN, lERR)  EOM04680 

450  LZTRN=LZTRN-*LAZTRN  EOM04690 


CALL  RE3ET<IERR) 

NEAR  MILLIMETER 

460  IF  < IPR0GH<9>.NE.9)  GO  TO  480 
WRITE  <100UT,1200) 

1PGM9-ID0PGM<9> 

DO  470  I=1,IPGM9 

CALL  NMMW<  FREQ  1 , ICLMAT , MMTRAN , lERR  > 
470  MMWTRH-MMUTRH4.MMTRAN 
CALL  RESET<IERR) 


EOM04700 

WAVE  PGM  <i><ti*«4i«**«***ii<*>k<«i4>**>i><«<it>>**<»«EOM0471  0 

EOM04720 
EOM 04730 
EOM04740 
i  EOM04750 

}  EOM04760 

EOM 04770 
EOM 04780 
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4dO 


490 

500 


51  0 

520 


CLOUD  TRANSMISSION  PCM  iii4i««i«i*i<i4isi<i<iW>ti**ii>>ii*«>«i>ii«4i>tii*«>«i4i>)>««EOM0479u 
IF  < IPROGN< 1 0>.NE. 1 0>  GO  TO  500  EOM04800 

IPGMi 0=ID0PGM< 1 0 >  EOM04810 

DO  490  1*1. IPGMI 0  EOM04820 

WRITE  < lOOUT, 121 0)  EOM04e30 

CALL  CLTRAN<CTRANS.UAVEt .1. IERR>  EOM04840 

CLTRN=CLTRN>*CTRANS  EOM04850 

CALL  RESET<IERR>  ...  ,  EOM04860 

CUIC  MUNITION  EXPEHDITURES/'INVERSE  STATIC  TARGET  DETECTluN  PuM  >»**EOM 04870 

IF  ( IPROGN< 1 1  ;.NE. 1 1  )  GO  TO  520  EON04880 

WRITE  < lOOUT, 1220 j  EOM04S90 

IPGMI 1*IDOPGM< 1 1 )  EOM04900 

DO  510  1*1, IPGMI 1  EOM04910 

CALL  SCREEN< lERR, ICLMAT  )  EOM04920 

CALL  RESETS IERR>  EOM04930 

finite  CLOUD  RADIATIVE  TRANSFER  PGM  ****>«.****>*>».******>icEOM04940 


530 
54  0 


550 

C+ll'**!* 

56  0 


57  0 

575 

♦ 

♦ 

576 

58  0 


IF  < IPROGN< 12 j .NE. 12 >  GO  TO  540  EOM04950 

WRITE  <IOOUT,1230>  EOM04960 

IPGM12=ID0PGM< 12  )  EOM04970 

FCLOUD  USES  IPHFUN  FOR  PHASE  FUNCTION  DATA  EOM04980 

DO  550  I*1,IPGM12  EOM04990 

CALL  FCLOUD<WAVE1 ,FTRANS, IERR>  EOM05000 

CALL  RE3ET<IERR)  EOM0501 0 

OVERCAST  SKV  RADIATIVE  TRANSFER  PGM  EOM05020 

ii-  <  IPROGH<  i  3  ) . HE  .  1  3  j  GO  TO  560  EOM05030 

WRITE  < lOOUT, 1240>  EOM05040 

IPGM13=ID0PGM< 13)  EOM05050 

DO  550  I=1,IPGM13  EOM05060 

CALL  OVRCST<WAVE1 ,OTRANS,IERR>  EOM05070 

CALL  RESETS lERR)  EOM05080 

If >•<««,).  SELF-SCREENING  SMOKE  GRENADE  PGM  EOMO5090 

IF  < IPROGN< 14).NE, 14>  GO  TO  575  EOM05100 

WRITE  < lOOUT, 1250)  EOMC5110 

IPGM14=ID0PGM< 14)  EOM05120 

DO  570  I*1,IPGM14  EOM05130 

CALL  GRHADE< WAVE  1 , ICLMAT, GRTRAM.IERR)  EOM05140 

GRNTRN*GRNTRN*GRTRAN  EOM05150 

CALL  RESET< lERR)  EOM05160 

f  If  Oof  <!<>«<  IK  IK*  «*>•>>«•  «<*!!'>«•  *>»  EOM05  1  70 

IF< IPROGN<  4 ) , GT . 0 , OR . IPROGN<  5  > . GT . 0 . OR , IPROGN<  6  > , GT . 0 , OR . 1PR0GN<  7  > 

.GT . 0 .OR . IPROGNCS ).GT. O.OR. IPR0GN<9).GT. 0 . OR . IPROGN< 1 0>.GT . 0 .OR. 

IPROGN< 14).GT. 0)  GO  TO  576 
GO  TO  580 

CALL  COMPLT<  LOTRNS , XSTRN , SMKTRN, DRTRN, LZTRN, MMWTRN, GRNTRN , CLTRN  ) 

CONTINUE 


WRITE 

STOP 


<  lOOUT, 1260) 


1  000 
1  01  0 


FORMAT<2A4, IX, 1 0E7 , 4 > 
FORMAT<  1HO,20X,75H**'*-EOMAIN 
UENCE,  DEFAULT  TO  ONE  CYCLE 
1  020  FORMAT< 1  HO, 20X, 74H***E0MAIN 


II 


WARNING*'*'* 

//> 

ERROR***  FREQ,  WAVL,  OR  WVNUM 
NOT  INPUT,  RUN  TERMINATED  // ) 

1030  FORMAT< 1H0,20X,46H***EOMAIN  ERROR***  END  OF  READ  SENTINEL 
I/, 1X,20X,28HRESULTS  MAY  BE  UNPREDICTABLE) 


EOM051dO 
EOM 05190 
EOH 05200 
EOM0521 0 
EOM05220 
EOM 05230 
EOM05240 

EORUN  CYCLE  CARD  OUT  OF  SEQEOM05250 

EOM05260 
CARD  WASEOM05270 
E0n05280 
ABSENT  /EOM05290 
EOM0S300 


1  040  FORMAT< 1  HO, 20X,80H***EOMAIN  ERROR***  INPUT  CARD  DETECTED  WHICH  DOEEOM05310 
IS  NOT  MATCH  CORRECT  INPUT  FORMAT//, IX, 20X, 1 3HTHE  CARD  WAS : , 2X , 2A4 >EOn05320 


1  05  0 
1  060 


****,/, IX, 20X, 15HVISIBILITYEOM05330 
'  E0M05340 


1  070 
1  080 
1  090 
1  1  00 

1 


FORMAT  < 1H0,20X,24H****  EOSAEL  WARNING 
AND  ,  47HEXTINCTI0N  ■  0.0,  VISIBILITY  CHANGED  TO  10.0  KM/ > 

FORMAT  < INI ,///////, IX, SOX, 30< IH*),/, fX,50X, 1 H* , 28X , 1 H* , /  EOM05350 

,1X,50X,30H*  ELECTRO-OPTICAL  SYSTEMS  *,/, 1X,50X, IH*,  EOM05360 

28X, IH*,/, 1X,50X,30H*  ATMOSPHERIC  EFFECTS  ♦,/  EOM05370 

, 1X,50X, 1H*,28X, IH*,/, 1X,50X,25H*  LIBRARY  EOM05380 

5H  *,/,1X,50X, 1H*,28X,1H*,/,1X,50X,30< 1H*>)  EOM05390 

FORMAT  < 1  HI ,/////, 58X, 1 1NRUN  HUMBER  ,12)  EOM05400 

FORMAT  <///1X,51X,28HIHDIVI0UAL  MODULES  SELECTED)  EOM05410 

FORMAT  <1X,62X,2A4)  EOM05420 

FORMAT  < 1H0,63X,9HBEGINNING, t2X,6HENDING,//,39X, MHWAVEHUMBERCCM*  EOM05430 

4H*- 1  ) , 6X , F 1 0 . 3 , 1  OX , F 1 0 . 3 , // , 39X , 1 9HWAVELENGTH<  M I CRONS ) ,  EOM 0544  0 
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2  5X ,  F 1  0 . 3, 1  OX ,  F 1  0 , 3 ,  ,  3SX ,  i  4HFReQUENCV<  GHZ  >,5X,F15.3,5X, 

3  F^5.3.//'> 

1110  FORMAT  < 1H0,62X, 10HVISrBILITV,/,62X,F5.2,3H  KM > 

1 120  FORMAT< 1H1 > 

1130  FORMATt  IHl  .40X,20HSPOT  CONTRAST  MODULE  > 

1140  FORMAT< IHl .40X, 17HTUR8  LASER  MODULE  //> 

1150  FORMAT< 1H1 ,40X, 30HBASCAT  LASER  SCATTERING  MODULE  //> 

1160  FORMAT  ^ 1  HI , 40X . 46HXSCALE  HORIZONTAL-SLANT  PATH  EXTINCTION  MODULE 

1  ///'i 

1170  FORMAT  < 1H1 . 45X, f 9HSM0KE  MODEL  MODULE  7777 > 

1180  FORMAT  <1H1,40X,26H  DIRT  TRANSMISSION  MODULE  7/7) 

1190  FORMAT  <1H1,40X,28H  LASER  TRANSMITTANCE  MODULE  77) 

1200  FORMAT  <1H1,45X,29H  NEAR  MILLIMETER  WAVE  MODULE  777) 

1210  FORMATC INI ,40X,27HCLOUD  TRANSMITTANCE  MODULE  777) 

1220  FORMATOHI  ,20X,43HCW1C  MUNITION  EXPENDITURES  7  INVERSE  STATIC 
1  24H  TARGET  DETECTION  MODULE  ) 

1230  FORMATS  INI ,40X,38HFINITE  CLOUD  RADIATIVE  TRANSFER  MODULE  777> 

1240  FORMAT< INI ,40X,3eHOVERCAST  SKY  RADIATIVE  TRANSFER  MODULE  777) 

1250  FORMATS  INI ,40X,35HSELF-SCREENING  -SMOKE  GRENADE  MODULE  777) 

1260  FORMAT  < 1 X , 77777 , 1 X , SOX , 1 4HEND  E05AEL  RUN) 

END 


EUM05450 
EOM05460 
EOM03470 
EOM05480 
EOM054S0 
EOM05500 
E0M0S5) 0 
EOM05520 
EON 05530 
EOM0554C 
EOM05550 
eOM05560 
EOM05570 
EOM05580 
EOM05590 
EOM 05600 
EOMOS61 0 
EOM05620 
EOM05630 
EOM05640 
EOM 05650 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


SUBROUTINE  RESET  (lERR"* 

THE  PURPOSE  OF  THIS  ROUTINE  ISi  <t)  TO  RESET  THE  SEQUENCING  OF 
DATA  CAROS  DUE  TO  AN  ERROR  IN  A  PREVIOUS  NODULE  OR  <2>  TO  READ 
A  SENTENAL  CARO  THAT  DELINEATES  THE  END  OF  A  DATA  SET  (SEE 
BELOW  FOR  DEFINITION  OF  A  DATA  SET >  OR  <3>  TO  STOP  THE  PROGRAM  - 
THIS  LAST  MODE  IS  USALLV  FOR  DEBUGGING  OR  TO  ONLV  CHANGE  A  CARD 
IN  A  COMPLETE  RUN. 


COMMON 


RES0001 0 
RES00020 
RES00030 
RES00040 
RES00050 
RES00060 
RES0007C 
RES00080 
RES00090 
RES001 00 
RES001 1 0 
RES00t20 
RES00130 
R|S00140 

rIsooiso 

RES00160 

/’I0UHIT7I0IH, lOOUT, IPHFUN,LOUNIT,NDIRTU,NCLIMT,KSTOR,NPLOTURES00170 


TO  DELINEATE  THE  END  OF  A  DATA  SET  A  CARD  THAT  HAS  JUST  END 
ON  IT  MUST  BE  INSERTED  AS  A  SENTINEL  CARD:  A  DATA  SET  IS 
DEFINED  AS  THAT  COMPLETE  SET  OF  CARDS  NECESSARV  TO  RUN  THE 
CALLED  MODULE  THE  NUMBER  OF  TIMES  AS  SPECIFIED  OH  THE  IDOPGM< I 
CARD.  STOP  MAV  ALSO  BE  INSERTED  AS  A  SENTINAL  CARD.  IN  WHICH 
CASE  THE  PROGRAM  WILL  BE  TERMINATED  AT  THAT  POINT  -  THIS  IS 
NOT  THE  NORMAL  TERMINATION. 


IST0P2  /'2HEN.2HD  .2HST.2H0P/' 


DATA  ICHCK1 , ICHCK2> ISTOP? 

IF( lERR.EQ. 1 >  GO  TO  1 

5  CONTINUE 

C  FOR  UNIVAC  AND  IBM 

C  READ  < lOIN. 1 00.END=2 >  ISNTL t , ISNTL2 

READ  (lOIN.lOO)  ISNTL1 . ISNTL2 

C  TO  EXECUTE  THIS  ROUTINE  OH  A  'CDC'  MACHINE  COMMENT  OUT  THE 
C  PRECEDING  LINE  AND  UNCOMMENT  THE  NEXT  TWO  LINES  C3  AND  C4 . 

C3  READ( lOIN, I  00  )  ISNTL 1 , ISNTL2 
C4  IF<EOF< lOlN))  2, t  0 

10  IF<< ISNTLl  .HE. ICHCKl  .AND, 1 SNTL2 . NE . ICHCK2  )  . AND . 

1  < ISNTLl .NE. I3T0P1 .AND. ISNTL2. HE. ISTOP2)>  GO  TO  5 

IF  < ISNTLl .EQ. ISTOPt .AND, ISNTL2,EQ. IST0P2)  STOP 
RETURN 

1  WRITE<  lOOLIT.  102> 

C  FOR  UNIVAC  AND  IBM 

C6  READ  < lOlN, 1 00,ENO«2)  ISNTLl . ISHTL2 

6  READ  <IOIN.100>  ISNTLl . 1SNTL2 

C  TO  EXECUTE  THIS  ROUTINE  ON  A  'CDC'  MACHINE  COMMENT  OUT  THE 
C  PRECEDING  LINE  AND  UNCOMMENT  THE  NEXT  TWO  LINES  C3  AND  C4 . 

C3  READ< lOIN, 100)  ISNTLl . ISNTL2 
C4  IF<EOF< IOIN>>  2,20 

20  CONTINUE 

IF  << ISNTLl  .NE. ICHCKl  . AND . ISENTL .HE . ICHCK2  > . AND . 

1  < ISNTLl ,NE. ISTOP1 .AND, ISNTL2.NE. IST0P2))  GO  TO  6 

IF  < ISNTLl .EQ. ISTOPl .AND. ISNTL2.EQ. IST0P2)  STOP 
IERR=>0 
RETURN 

2  WRITE  < lOOUT, 1 01  )  lOIN 

1 00  FORMAT  <2A2) 

101  FORMAT  < IX, 120< IH*  ),/, 1X,29H  ERROR  IN  INPUT  CONTROL  FILE  ,14, 

+  21H  -  PROGRAM  TERMINATED,/, IX, t20< IHf)) 

102  FORMAT< lH0,50Hf**«  CARD  SEQUENCE  RESET  DUE  TO  ERROR  IN  PREVIOUS 

1  ISHMODULE  <IERR=1)//) 

STOP 

END 


RES00180 
RES00190 
RES00200 
RES0021 0 
RES00220 
RES00230 
RES00240 
RES00250 
RES0026C 
RES00270 
RES002e0 
RES00290 
RES00300 
RESu03i 0 
RES00320 
RES00330 
RES00340 
RES00350 
RES003S0 
RES00370 
RES003e0 
RES00390 
RES00400 
RES004t  0 
RES00420 
RES00430 
RES00440 
RES00450 
RES004S0 
RES00470 
RES00480 
RES00490 
RES00500 
RES0051 0 
RES00520 
RES00530 


IB 


oooooooo 


ooo  oooooormoooo 


SUBROUTINE  ILLUMC LAMBDA, LD, EO > 

REAL  LAMBDA, LUNPHA 

COMMON/'IOUNIT/'IOIN,  lOOUT,  IPHFUN,  LOUNIT,  ND I RTU ,  NCL 1 MT ,  KSTOR ,  NPLOTU 

>«■  f 4>  liiO  *  «  Xi « I*  *  *  *  *  « >k  4i  *  itiiti  I*  Ik  4i  *  *  «  *  4i  *  *  *  *  *  *■  <)■  ■*  ■*  •  « 4i  I*  Ik  *  >(1  *  4>  >k  O  >*  *  Xi  4i  « 

SUBROUTINE  ILLUM  RETURNS  THE  EXTRATERRESTRIAL  IRRADIANCE  EO 
AT  WAVELENGTH  LAMBDA.  IF  LD  »  0,  THE  VALUE  GIVEN  IS  SOLAR 

IRRADIANCE.  IF  1  <  LD  <  28  THE  VALUE  GIVEN  IS  LUNAR  IRRAD¬ 

IANCE  ON  LUNAR  DAY  LD,  WITH  DAY  28  CORRESPONDING  TO  FULL 
MOON  AND  DAY  14  BEING  NEU  MOON. 

SUBROUTINE  COMPUTES  VALUE  OF  LUNAR  PHASE  ANGLE,  IF  REQUIRED, 

AND  CALLS  ONE  OF  THE  EOSAEL  ROUTINES  SOLARS  OR  SMOON . 

XI  k  X<  X<  X<  Xc  X>  X>  XI  X>  X<  X<  XI XI XI W  *  Xi  Xi  XI  X>  XI XI  X<  XI  X>  X<  XI XI XI  X>  XI «  X<  X<  Xt  XI XI  X<  X>  X<  X<  X< «  XI  Xt  X>  X<  X<  Xi  X>  X<  XI  X>  X>  X<  XI XI XI  X<  Xi  XI  X>  XI  X>  Xi  X> «  XI XI XI 

IF< ILD.GT. 0)  GO  TO  10 
E  0*SOLARS<  LAMBDA  > 

GO  TO  100 

LD  GT  0  =>  EO  =  LUNAR  VALUE 


ILL0001 0 
ILL00020 
ILL00030 
ILL00040 
ILL00050 
ILLOOOSO 
ILL00070 
ILL00080 
ILLOOOSG 
ILL001 00 
ILL001 1 0 
ILL00120 
ILL00130 
ILL00140 
ILLuOISO 
ILL00160 
ILL00170 
ILL0018C 
ILLOOiSO 
ILL00200 
ILL0021 0 


10  ILD=LD 

IF< ILD . GT . 1 4  )  ILD=2S-ILD 
LUNPHA=180.  OxiFLOAT<  ILD)/14.0 
EO=SMOON<  LAMBDA, LUNPHA  > 

100  WRITE< lOOUT, 1 000 >  EO 
RETURN 

1  000  FijRMAT<32H0  EXTRATERRESTRIAL  IRRADIANCE- 
END 


ILL00220 
ILL 00230 
ILL00240 
ILL00250 
ILL00260 
ILL00270 

,  IPEi  0.4,  1  1H  Ui''M2-SR-MU>lLL00280 

ILL00290 
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FUNCTION  SOLARS<‘ WNVL  >  SOL00010 

SOL  U  Cl  020 

CALCULf^TE  THE  INTENSITY  OF  THE  SOLAR  SPECTRUM  FOR  WAVELENGTH  < WAVLSOL00050 

80L00040 


UNITS: 

SOLARS  . . .  WATTS  M-2  MICRON-l 
WAVL  .  MICRONS 

IF  <WAVL.LT. 0. IS.OR.WAVL.GE, 1 00. >  GO  TO  tOO 
IF  <UAVL.GE. 0.15. AND. WAVL. LE.0.43>  GO  TO  200 
IF  < WAVL. GT. 0.43. AND.WAVL.lt. 0.58)  GO  TO  300 
GO  TO  400 
1 00  SOLARS=0. 0 
RETURN 

200  Z-<<WAVL-,415)^0.68)**2 
SOLARS= 1 775 . ♦EXPC  272  > 

RETURN 

300  CONTINUE  ,  , 

SOLARS=<  -61142.  ♦WAVL**4  >+<  1  344477  .  kWAVL*-»3  >-<  1  1  02^6  .  * 
i  UAVL*>i'2) 

SOLARS-<  SOLARS+39952 . 74WAVL-5371 . >71 00 . 

RETURN 

400  IF  <:WAVL.GE.2.5)  GO  TO  500 

SOLARS35331 .9*EXP<-1  .SSSn-UAVL) 

RETURN 

500  S0LARS*2288 . 38*i:  WAVL-^kC  -3 . 9765  >  > 

RETURN 

END 


SOL  00 050 
SOL00060 
SOL00070 
SOL  0  0 080 
SOL00090 
SOL001 00 
SOL  001 1 0 
SOL00120 
SOL  001 30 
SOL00140 
SOL00150 
SOLO  01 60 
SOL00i70 
SOL00180 
30L001 90 
SOL00200 
30L0021 0 
SOL  00220 
SOL 00230 
SOL 00240 
SOL00250 
SOL  0  0260 
SOL0  02i'0 
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FUNCTION  SHOONCWLAM, ANGLE) 

CALCULATE  THE  INTENSITY  OF  MOONLIGHT  FOR  HAVELENGTH  < ULAM > 
AND  PHASE  ANCLE  < ANGLE) 

UNITS : 

SMOON  . . .  WATTS  M-2  MICRON-1 
ANGLE  . , .  DEGREES 
WLAM  ....  MICRONS 
SMOON=0, 0 

IF  < ANGLE. GT. 160. )  RETURN 

SM00N=<3.426E-9*AHGLEt"»4-l  .  63E-6*ANGLE*>*3+3 . 01  E-4* 

1  ANGLEt"*'2-.  0266>»ANGLE+  .9S82)>H  00. 

ALBED=0.4 

IF  <ULAM.GE.5. )  GO  TO  200 

IF  <;WLAM.GT.2.8)  GO  TO  1  00  , 

IF  <WLAM.LE.1.)  ALBED=3.9633i.WLAM*-»4-1  0.73ubf«UAMff3+ 

1  10.2188*WLAM**2-3.9208*«LAM+.5512 

IF  <WLAM.GT.1.>  ALBED=.0482>*ULAM>»>*4-.3283>»WLAM**3+ 

1  .7584i>WLAMi'*2-.5745»WLAM+,2808 

GO  TO  200 

100  ALBED=.350+<  .  500- .  350  )*<  WLAM-2 . 8  )/'2 . 2 
200  SM00N«2. 04472E-07>i<30LAR3<ULAM)4<ALBED«3MOON 
RETURN 
END 


SMN0001 0 
SMN00020 
3MN00030 
SMN00040 
SMN00050 
SMN00060 
3MN00070 
SMN00080 
SP1N00090 
3MN001 00 
SMN001 1 0 
SMN00120 
SMN00130 
SMN00140 
SMH00150 
SMN00160 
SMNOOl 70 
3MN00180 
SMNOOl 90 
3MN00200 
SMH0021 0 
SMN00220 
3MN00230 
SMN 00240 
SMN00250 
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FUNCTION  JPhSCT<ICAT> 

THIS  FUNCTION  CONVERTS  THE  INTEGER  CODE  FOR  PASQUILL  CATEGORY 
TO  THE  ALPHA  CHARACTER 
DIMENSION  NPASCT<6> 

DATA  NPASCT/'IHA,  1HB,  iHC,  1HD,  1HE,  1HF/ 

JPASCT-NPASCT< ICAT) 

RETURN 

END 


JPAC  00  I  0 
JPA00020 
JPA00030 
JPA00040 
JPAOOOSO 
JPA00060 
JPA00070 
JPAOOOSO 
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SUBROUTINE  PFUNC<IDN> 

LOGICAL  ISP0TA0READ,N16 
DIMENSION  PFSPOK  16>,PFH<65> 

COMMON  /SP0TL0r^ISP0TiL0READ,N16 

COMMON/IOUNIT/'IOIN, lOOUT, IPHFUH, LOUNIT • HDIRTU, NCL IMT , KSTOR , NPLOTU 
COMMON  /'C0NST/PI,PI2,PIRAD,TW0PI >TORRMB,COEGK 
COMMON  /’CGEOM/'COSGM,COSBT,  COSIN 

COMMON  /'BASP0T/ANG<65),SUM<65),WVL<  16>,NWVL.  ALB<  I6>.BS<  16>, 

|■BE<  16),SINGUV,PF<65>,LMPX 

THIS  SUBROUTINE  PERFORMS  PHASE  FUNCTION  READING  AND  INTERPOL¬ 
ATION  OPERATIONS  FOR  THE  SPOT  AND  BASCAT  MODULES,  THE  FILE  IN 
WHICH  THE  PHASE  FUNCTION  DATA  RESIDES  IS  PFNDAT.  USERS  MAY  IN¬ 
SERT  PHASE  FUNCTIONS  OF  THEIR  OWN  SPECIFICATION  INTO  PFNDAT 
UNDER  AN  ID  NUMBER  0.  THIS  PHASE  FUNCTION  MAY  HAVE  ANY  AR¬ 
BITRARY  NORMALIZATION,  SINCE  PFUNC  WILL  RENORMALIZE  IT  TO 
CONFORM  TO  THE  NORMALIZATIONS  USED  IN  SPOT  AND  BASCAT. 

FOR  FURTHER  DETAILS  OH  THIS  PROCEDURE, 

THE  USER  IS  REFERRED  TO  CHAPTER  16  OF  THE  EOSAEL  80  TECHNICAL 
DOCUMENTATION  MANUAL,  WHERE  THE  STRUCTURE,  USE,  AND  MODIFICATION 
OF  THE  PFNDAT  FILE  IS  DISCUSSED. 

NOTE  ***  FOR  USER-DEFINED  PHASE  FUNCTIONS  <.IDN=0>,  THIS  ROUTINE 
WILL  INTERPOLATE  OVER  WAVELENGTH  AND  ANGLE  FOR  THE  SPOT 
MODULE.  FOR  THE  BASCAT  MODULE,  HOWEVER,  NO  WAVELENGTH 
INTERPOLATION  IS  PERFORMED  FOR  THE  USER-DEFINED  PHASE 
FUNCTION.  ONLY  RENORMALIZATION  IS  PERFORMED  IN  THIS 
LATTER  CASE. 

MAXID  IS  THE  NUMBER  OF  DIFFERENT  DISTRIBUTIONS  -  (PHASE  FUNCTIONS 
MAXID=12 

CHECK  THE  ALLOWABLE  RANGE  OF  DISTRIBUTIONS 

IF<<IDN.GT. MAXID). OR. <IDN.LT,0>>GO  TO  4S1 

DATA  INITIALIZATIONS 

DO  40  1-1,65 
PF< I )-0. 

ALBE-0. 

BEX=0. 

BSC=0, 

ANGULAR  READ  BLOCK  COMMON  TO  SPOT  AND  BASCAT 


G 

—  — 

c 

50 


60 

C 

C  —  UxtiKi 

C 


c 

C'Ci"* 

c 

200 


READ  IN  ANGLES  AT  WHICH  PHASE  FUNCTION  IS  DEFINED 
1  =  1  +  1 

LI  “<  1-1  )>*1  1  +  1 
Lll-Ll+l 0 

IF<L1 1 .EQ.66>L1 1=65 

IF<L1 1 .GT.66)G0  TO  492 

READ< IPHFUN,60)< ANG<L),L»L1  ,L1  1  ) 

FORMAT<  1  KF6.2,  IX)) 

CHECK  THIS  ROW  OF  DATA  FILE  FOR  TERMINATION  SENTINEL 
DO  100  K=L1,L11 

IF<<ANG<K).GE.999.99),AND.tL1 1 .LT.65))G0  TO  200 
IF<K.EQ.65)G0  TO  200 
CONTINUE 
GO  TO  50 

LNAX  IS  THE  NBR  OF  ANGLE  AND  NBR  OF  PHASE  FUNCTION  VALUES+1  HERE. 
LMAX-K 


PFUOOOl 0 
PFU00020 
PFU00030 
PFU00040 
PFU00050 
PFU00060 
PFUOOOZO 
PFU00080 
PFU00090 
PFUOOl 00 
PFUOOl 1 0 
PFU0CI120 
PFU00130 
PFU00140 
PFU00150 
PFUOOl 60 
PFU00170 
PFU00180 
PFU00190 
PFU00200 
PFUC021 0 
PFU00220 
PFU00230 
PFU00240 
PFU00250 
PFU 00260 
FFU0U270 
PFU002S0 
PFU0029O 
)PFU00300 
PFU0031 0 
PFU 00320 
PFU00330 
PFU 00340 
PFU00350 
PFU 00360 
PFU00370 
PFU00380 
PFU00390 
PFU00400 
PFU0041 0 
PFU00420 
PFU00430 
PFU00440 
PFU00450 
PFU 00460 
PFU00470 
PFU004S0 
PFU 00490 
PFU 005 00 
PFU 0051 0 
PFU00520 
PFU00530 
PFU 00540 
PFU00550 
PFU00560 
PFU00570 
PFU00580 
PFU00590 
PFU 006 00 
PFU0061 0 
PFU 00620 
PFU00630 
PFU00640 
PFU00650 
PFU 00660 
PFU00670 
PFU00680 
PFU00690 
PFU00700 
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250 

C 

c 


400 
1  000 
1  05  0 
C 

c 


1  060 
1  070 
C 

c 


DO  250  L“1  ,LM^»X 

ANG<  L  >-COS<  ANG<  L  >*PIRAD> 

REDUCE  DUE  TO  SENTINEL  OF  999.99 

IF<L1 1 .LT.65>LMAX»K-1 
IDNM=IDN-i 

KMAX=IFIX<  ALOG<FLOAT<LMAX-l  >  )/ALOG<  2 . 0  >-»0  ,  1  ) 

RESET  PARAMETERS  FOR  BASCAT  PROCESSING  IF  APPROPRIATE. 

IF< ISPOT>  GO  TO  260 
NUv'L=1 

WVL< 1  )=SINGWV 
CONTINUE 

IF<< IDN.EQ. 1 >.OR.< IDN.EQ. 0. )>  GO  TO  1050 

READ  PAST  AEROSOL  DATA  NOT  OF  CURRENT  INTEREST 

DO  1000  I=1,IDNM 
DO  1 000  11=1,16 

READ< IPHFUN,300)  lANG, ID , WAVE , ALBE . BEX, BSC 
F0RMAT<2< I2,1X),F5.2,1X,F8.6,1X,2<E12.6,1X)> 

IF< lANG.NE.LMAX)  GO  TO  493 
READ< IPHFUN,400)  <PF<L>,L-1 ,LMAX> 

F0RMAT<6«:E12.6,  IX)) 

CONTINUE 

CONTINUE 

OMIT  WAVELENGTH  CHECKS  FOR  USER-DEFINED  PHASE  FUNCTION. 

IF< IDN.EQ. 0)  GO  TO  1070 

THE  NEXT  LOOP  PERFORMS  THE  FOLLOWING  OPERATIONS  : 

<A>  IT  VERIFIES  WHETHER  OR  NOT  ALL  INPUT  WAVELENGTHS  LIE 
WITHIN  THE  0.2-12.0  MICROMETER  RANGE  <W1TH  LIMITS 
EXTENDED  TO  PLUS  OR  MINUS  5X). 

<8)  IF  THE  PHASE  FUNCTION  IS  HOT  USER-SPECIFIED  AND  THE  INPUT 
WAVELENGTH  BAND  LIES  WITHIN  THE  0.2-2. 0  BAND,  THEN 
INTERPOLATION  IS  NOT  POSSIBLE  DUE  TO  THE  PRESENCE  OF 
ONLY  TWO  DATA  POINTS  <AT  0.55  AND  1.06)  IN  THIS  REGION. 

AS  A  RESULT,  THE  0.55  AND  1,06  VALUES  ARE  ASSIGNED  TO 
INDIVIDUAL  POINTS  IN  THE  INPUT  WAVELENGTH  BAND.  THOSE 
POINTS  WITH  WAVELENGTH  VALUES  LESS  THAN  OR  EQUAL  TO  0.8 
MICROMETERS  ARE  ASSIGNED  THE  0.55  DATA.  ALL  OTHER  WAVE- 
LENTHS  ARE  ASSIGNED  THE  1.06  DATA. 

<C)  IF  AN  INPUT  WAVELENGTH  LIES  OUTSIDE  OF  THE  3-5  OR  8-12 
MICROMETER  BANDS,  BUT  IS  WITHIN  SX  OF  AN  EXTREMUM  FOR 
THESE  BANDS,  IT  IS  RESET  TO  THE  EXTREMUM  WAVELENGTH 
VALUE . 

<D)  IF  AN  INPUT  WAVELENGTH  LIES  BETWEEN  BANDS,  EXECUTION  IS 
TERMINATED  AND  AN  ERROR  MESSAGE  IS  PRINTED, 

DO  1060  I-1,NWVL 

IF<<WVL<I).LT.0.19).OR.<WVL<I).GT.12.049)>  GO  TO  504 
IF<  WVL< I > . LE . 0 . 8  )  WVL< I  )=0 . 55 

IF<<  WVL<  I  ).GT.  0.8).AND.<WVL<  i  >.LE,2. 1  >>  WVL<1 1  )=1  .  06 
IF<WVL< I  ).GT, 12. 0)  WVL<I>-12.0 

IF<  <  WVL< I ) . GT . 5 . 0  )  . AND , <  WVL< I  ) . LE , 5 . 25  >  >  WVL< I  )»5 . 0 
IF<  <  WVL< I ) . GE . 7 . 6  )  . AND . <  WVL< I > . LT . 8 . 0 ) >  WVL< I  )»8 . 0 
IF<  <  WVL<  1  ) .  GE  .  2 . 85  > .  AND .  <  WVL<  I  ) .  LT  .  3 . 0  )  )  WVL<  I  )=3 . 0 
IF<<WVL< I  ).GT,2. 1  ).AHD.<WVL< I ).LT,2.85))  GO  TO  498 
IF<<WVL< I  ).GT.5.25>.AND,<WVL< I ).LT.7.6))  GO  TO  498 
CONTINUE 
CONTINUE 

MAIN  INTERPOLATION  LOOP 

DO  2000  I-1,NWVL 
IF< I .GT. 1 )  GO  TO  1260 


PFUuCi71  0 
PFU00720 
PFUU0730 
PFU00740 
PFU00750 
PFLl  0  076  0 
PFU00770 
PFU 00780 
PFU 00790 
PFU00800 
PFU00S1 0 
PFU00820 

pruousso 

PFU 00840 
PFUOOSsO 
PFU00860 
PFU00S70 
PFU00880 
PFU00S90 
PFU 009 00 
PFU0091 0 
PFU00920 
PFU00930 
PFU00940 
PFU00950 
PFU00960 
PFU00970 
PFU00980 
PFU 00990 
PFU01 000 
PFU 01 01 0 
PFU 01 020 
PFU01 030 
PFU 01 040 
PFU01 050 
PFU 01 060 
PFU01 070 
PFUC1 080 
PFU01 090 
PFU01 1 00 
PFU01 1 1 0 
PFU01 120 
PFUOt 130 
PFU01 140 
PFU01 150 
PPUOl 160 
PFU01 170 
PFUOl 180 
PFU01 190 
PFU01200 
PFU0121 0 
PFUOl 220 
PFU01230 
PFUOl 240 
PFU01250 
PFU 01 260 
PFU01270 
PFU01280 
PFUOl 290 
PFU01300 
PFU0131  0 
PFU01320 
PFUOl 530 
PFUOl 340 
PFU01350 
PFU01360 
PFU01370 
PFU 01 380 
PFU01390 
PFU01400 


25 


1)00  CONTINUE 

READC IPHFUN,300;  lANG, I D . UAVEH , ALBH , BEXH . B3CH 
READ< IPHFUN.4C0)  <PFH<L  J,L=t ,LMAX  > 

IF<;<  IDN.EQ,  0),AND.<  .NOT,  1SP0T)>  GO  TO  1280 
It- (  WVl<  I  > .  LT  ,  UAVhH  .)  GO  TO  1100 
1 150  CONTINUE 

RtACu  IPHFUN, 300  >  I ANG . ID, UAVE , ALBE , BEX, BSC 
READ< IPHFUN, 400>  < PF< L > , L= 1 , LNAX > 

IF<WVL< I >.LE .UAVE>  GO  TO  1260 
1160  CONTINUE 

wAvEH=u)AVE 

ALBH=ALBe 

BEXH=Bhx 

DO  1240  L=1,LMAX 
124  0  PFH')  L  >  =  PF<  L  j 
GO  TO  1150 
1260  CONTINUE 

GO  TO  next  wavelength  INTERPOLATION  INTERVAL  IF  INPUT  UAVE- 
C***  LtNGTH  IS  GREATtR  THAN  THE  MAXIMUM  OF  THE  CURRENT  uHE . 

C 

IF<UIVL<  I  i.GT.UAVE:)  GO  TO  1160 

C***  RENORMALIZE  LOWER  END  OF  INTERPOLATION  INTERVAL 

^1280  CONTINUE 

SuM< 1 >=0.0 
DO  1200  L=2,LMAX 

1200  SUM<L>=';<ANG<L-1  >-ANG<  L  >  >*<  PFH<  L- 1  )+PFH<  L  > 'xM  .  0  >+SUM<  L -  1  > 
SUMT=SUM<LMAX  > 

DO  1250  L=1 ,LMAX 
1250  PFH<L)*PFH<L)/SUMT 
C 

Ct>+>»  BRANCH  TO  FINAL  PROCEDURE  FOR  BASCAT,  USER-DEFINED  PHASE 
FUNCTION  IF  APPROPRIATE, 

^  IF<<IDN,EQ.0>.AND.< .NOT.ISPOT>>  GO  TO  2500 

C 

C***  RENORMALIZE  UPPER  END  OF  INTERPOLATION  INTERVAL. 

C 

SUM< 1 >=0. 0 
DO  1400  L=2,LMAX 

14  0  0  SUMC  L  )=<  <  ANG<  L- 1  )- ANG<  L  >  >*<  PF<  L- 1  >+PF<  L  > )/4 . 0  >+3UM<  L- 1  > 
SUMT=SUM<LMAX) 

DO  1450  L=1,LMAX 
1450  PF<l:)  =  PF<L)/SUMT 

C***  BRANCH  TO  BASCAT  WAVELENGTH  INTERPOLATION  PROCEDURE  IF 
C.***  APPROPRIATE. 

IF<  .NOT.  ISPOT>  GO  TO  2500 
C 

C*fH.  PERFORM  HALVING  SEARCH  FOR  COSINES  IN  PHASE  FUNCTION  DATA  FILE 
C***  WHICH  BRACKET  COSINE  INPUT  FROM  SPOT. 

C 

L  =  1 

LL=LMAX-1 
DO  1300  K>>1,KMAX 
LL-LLX2 
L  =  L-t-LL 

AT=COSIN-ANG<L> 

IF<AT,GT.O. >  L=L-LL 
J300  CONTINUE 

C***  PERFORM  SPOT  EXTINCTION  COEFFICIENT  AND  PHASE  FUNCTION 
C+*H.  INTERPOLATIONS  OVER  WAVELENGTH  AND  ANGLE. 

FACANG*<  COS IN-ANG<  L  >  >X<  AHG<  L+ 1 >-ANC<  L  >  > 

FACWVL=<  WVL< I >-WAVEH  >X<  WAVE-WAVEH  > 

BE< I >=8EXH+<BEX-BEXH>*FACWVL 


PFU01 4  t  0 
PFU014.-'i' 
PFU01 430 
PFU01 440 
PFUO 1  5  i' 
PhUOl 460 
PFUO  I  4  f"  0 
PFU01 480 
Pl-UOl  490 
PFU01 500 
Ft-  u0 1  5  1  0 
PFUO 1520 
Pt-UO  1  5.5  0 
PFUO 1540 
PFU0155C 
PFU01 560 
Pt-uOl  5(^0 
PFU01  5-8  0 
P  I-  U  0 1  D  9  0 
PFUOl 600 
Pi-UOl  6 )  0 
PFUOl 620 
PFUO i 630 
Pt-UOi  64  0 
PFUOl 650 
PFUOl 660 
PFUOl 670 
PFUOl 680 
PFUOl 690 
PFUOl 700 
PFU0171 0 
PFUOl 72 C 
PFUOl 730 
PFUOl 74  0 
PFUOl 7i0 
PFUOl 760 
PFU01770 
PFU017S0 
PFU0t790 
PFUOl 800 
PFUOl 81 0 
PFU01820 
PFU01830 
PrU01840 
PFUOi 850 
PFUOl 860 
PFUOl 870 
PFUO 1880 
PFUOl 890 
PFU01900 
PFU0191 0 
PFU01920 
PFUO 1930 
PFUO 1940 
PFUO 1950 
PFU01960 
PFU01970 
PFUOl 980 
PFU01990 
PFU02000 
PFU0201 0 
PFU02020 
PFU02030 
PFU02040 
PFU02050 
PFU020e0 
PFU02070 
PFU02080 
PFU02090 
PFU02’ 1 0 


) 
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PFSPOT<  I  >=PFH<  L  >•<  1  .  -FACrtNG-FACUVL+FHCANG^FAClilVL  >♦ 

+  PFH<  L+1  )•<  FACANG-FACANG^FACUVL  >-»PF<  L  >*<  FACWVL-FAC  ANG*FACUVL  >+ 
+PF<L>i >*< FhChHG^FhCUVL > 

2000  CONTINUE 
C 

C***  LOAD  FIRST  NUVL  ANGLES  OF  OUTPUT  ARRAV  PFC >  WITH  INTERPCLATEO 
C***  RESULTS  FOR  SPOT. 

C 

00  2200  N=il,NUVL 
2200  PF<N)=PFSP0T<N>/<4.*P1 > 

C 

FINAL  EXIT  FOR  SPOT  PROCESSING. 

GO  TO  500 
2500  CONTINUE 
FACUVL=0 . 

IF<iDN.EQ.0>  GO  TO  2700 
C 

C=*>i<*  BASCAT  ALBEDO,  EXTINCTION  COEFFICItNT,  AND  PHASE  t-UNCTION 
C**»  INTERPOLATION  OVER  WAVELENGTH. 

C 

FACWVL“<UVL<  1  )-UAVEH)/'<WAVE-U1AVEH:> 

2700  CONTINUt 

DO  2800  L=I,LMAX 

230  0  PF<  L  )  =  PFH<  L  )+<  PF<  L  >-PFH<  L  )  )>»FACUVL 
ALBC 1 >=ALBH+< ALeE-ALBH>*FACUVL 
BE<  i  >=BEXH+<  BEX-BEXH  >>fFACUVL 

FINAL  EXIT  FOR  BASCAT  USER-DEFINED  PHASE  FUNCTION  PROCEDURE. 
IF<IDN.EQ.O)  GO  TO  500 

FINAL  BASCAT  PHASE  FUNCTION  RENORMALIZATION. 

3UM<1>=0.0 
DO  2900  L»2,LMAX 

290  0  SUM<L)=<<ANG<L-1  )-ANG<  L  )  )•*<  PF<  L-1  )+PF<  L  >  >.-'4 . 0  )+3UM(L-1  > 
SUMT=SUM<LMAX  ) 

DO  2950  L=1,LMAX 
.295  0  PF<L  )  =  PF<L  )XSUMT 

C+f*  FINAL  EXIT  FOR  BASCAT  PROCESSING. 

C 

GO  TO  500 
C 

C***  ERROR  EXIT  BLOCK  COMMON  TO  SPOT  AND  BASCAT 

C 


PFU02120 
PFU021 30 
PFU02^  40 
PFU02150 
PFU021 60 
PFU02170 
PFUOZiaO 
PFU02190 
PFU02200 
PFU0221 0 
PFU02220 
PFU02230 
PFU 02240 
PFU 02250 
PFU02260 
PFU 02270 
PFU022&0 
PFU 02290 
PFU02300 
PFU0231 0 
PFU 02^20 
PFU02330 
PFU02340 
PFU 02350 
PFU02360 
PFU 02370 
PFU02J&0 
PFU02390 
PFU02400 
PFU 0241 0 
PFU 02420 
PFU02430 
PFU02440 
PFU 02450 
PFU02460 
PFU 02470 
PFU02480 
PFU 02490 
PFU02500 
PFU0251 0 
PFU02520 
PFU 02530 
PFU02540 
PFU02550 
PFU 02560 
F"U02570 
F'h  U  11258 0 


491  CONTINUE 
WRITE< I00UT,495 j 

495  FORMAT<  lH0,20X,58H*>*>»rPFUNC  ERROR*** 
+ABLE  RANGE  XX) 

STOP 

492  CONTINUE 
WRITE< I00UT,496) 

496  FORMAT< 1H0,20X,83H***PFUNC  ERROR*** 
+FOUND  OR  NUMBER  OF  ANGLES  EXCEED  65 

STOP 

493  CONTINUE 
WRITE< I00UT,497) 

497  F0RMAT< lH0,20Xi93H***PFUNC  ERROR*** 

+  NUMBER  OF  PHASE  FUNCTION  VALUES  00 

STOP 

498  CONTINUE 
WRITE< I00UT,499) 

499  FORMAT< 1H0, 1  OX,  79H***PFUNC  ERROR*** 
+L  INPUT  ARRAY  DO  NOT  LIE  WITHIN  XIH 
+Y  PFNDAT  DATA  BASE  X> 

STOP 

504  CONTINUE 

WRITE< IOOUT,505> 


PFU02590 
PFU 026 00 

AEROSOL  ID  HUMBER  OUT  OF  ALLOWPFU 026 1 0 

PFU02620 
PFU 02630 
PFU02640 
PFU 02650 

READ  TERMINATION  SENTINEL  NOT  PFU02660 

//)  PFU02670 

PFU02630 
PFU 02690 
PFU02V  00 

NUMBER  OF  SPECIFIED  ANGLES  ANDPFU027I0 

NOT  MATCH  XX >  PFU02720 

PFU02730 
PFU02/40 
PFU 02750 

SOME  OR  ALL  WAVELENGTHS  IN  WVPFU02760 
,45HWAVELENGTH  BANDS  COVERED  BPFU02770 


PFU02780 
PFU02790 
PFU 026 00 
PFU 0281 0 
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505  FORMAK  JHO,  1  OX.  1  09H*»'*PFUNC  ERROR***  SOME  OR  ALL  UAVELENGTHS  IN  UVPFU02Bi0 
+L  ARRAY  DO  NOT  LIE  WITHIN  OVERALL  ACCEPTABLE  RANGE  OF  0.2-12.0  /)  PFU0283C 
STOP  PFU02S4C 

500  RETURN  PFU02&50 

END  PFUu^af.  0 
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SUBROUTINE  XSCpLE< WrtVE, VIS , EXT55, XSTRN, lERR, ISLT, IFOG , RNHGE , ANGLE jXSr 0 00 1 0 
THE  PURPOSE  OF  THIS  ROUTINE  IS  TO  A>  FIND  THE  HORIZONTAL  EXT  I NCT I ONXSt C  0 02 0 
IN  t-OG  AT  THE  WAVELENGTHS  SPECIFIED  BELOW  FROH  THE  EhTInCTIOH  XSCOOujO 
AT  .55  UM  OR  B)  THE  EXTINCTION  ALONG  A  SLANT  PATH  AT  ALLOWED  XSC00040 

WAVELENGTHS  FROM  THE  EXTINCTION  AT  ,55  UM :  FOG  TVPE  1,  2,  OR  3,  XSCOOf'50 
MUST  BE  SPECIFIED  FOR  SLANT  PATHS,  XSCOOoSO 

***  ViSIBILlTV  =  BS .  OR  89.  IS  NOT  ALLOWED  AS  THIS  IS  USED  AS  AN  XSC00070 
INDICATOR  THAT  XSCALE  IS  BEING  CALLED  AS  A  SUBROUTINE  FROM  EITHER  XSC00080 
SP0T<88.>,  L0WTRAN<88.  >,  OR  CWIC<89.>,  NOT  EOMAIN!  XSC00090 

WAVE-LAMDA  IN  UM  -  MUST  BE  ,55,  1.06.  3. 0-5.0,  8.0-12.05,  XSC0C100 

***  ALL  EXTN'S  ARE  IN  KM*’*- 1  XSC001  1  0 

EXT55  =  EXTINCTION  AT  .55  UM  XSC00120 

EXT106  =  EXTINCTION  AT  1.06  UM  XSCuuiSu 

EXT35  =  EXTINCTION  FROM  3.0  TO  5.0  UM  XSC00140 

EXT8i2  =  EXTINCTION  FROM  8.0  TO  12.0  UM  XSC00150 

VIS=  VISIBILITY  IN  KM  -OR-  EXT55  IN  KMf*-l  XSC00160 

EXT5d  is  NOT  CHANGED  BY  THIS  ROUTINE.  XSCOOIZO 

INPUT;  THERE  IS  A  MAXIMUM  OF  3  CARDS  TO  EXECUTE  THIS  MODULE  XSC00190 

THE  CARDS  MAY  BE  INSERTED  IN  ANY  ORDER  WITH  THE  EXCEPTION  OF  XSC00200 

THE  LAST  CARD  WHICH  SIGNIFIES  THAT  EXECUTION  IS  TO  BEGIN.  XSCCi0210 

THE  CARDS  ARE  INPUT  WITH  FORMAT  < A4 , 6X , 5< F6 . 2 , 1 X > > .  XSC 00220 

EACH  CARD  BEGINS  WITH  A  4  LETTER  IDENTIFIER  IN  COL  1  -  4  XSC00230 

FOLLOWED  BY  AS  MANY  <REAL>  FIELDS  AS  NEEDED,  6  COL  PER  XSC 00240 

FIELD  BEGINNING  IN  COL  11,  WITH  A  BLANK  BETWEEN  EACH  SUBSEQUENT  XSC00250 
FIELD.  THE  CARDS  ARE  NOT  ORDER  DEPENDENT.  XSC00260 

IF  GEOMET  OPTION  IS  BEING  USED,  THEN  ONLY  THE  IDENTIFIER  HORZ, 

SLNH,  OR  SLNS  IS  TO  BE  RFAD  IN  < NO  ADDITIONAL  PARAMETERS  NEEDED). 

FOG  FOG  TYPE,  RAIN  RATE  < MMXHR > :  RAIN  RATE  ONLY  NEEDED  XSC00270 

WHEN  FOG  TYPE=4.  XSC00280 

HORZ  HORDIS  < KM >  jHORIZONTAL  PATH  CALCULATION  XSCOOSOO 

SLNH  HORDIS  <KM),  ANGLE  <DEGREES>i  SLANT  PATH  CALCULATION  XSC00310 

SLNS  SLTDIS  <KM),  ANGLE  <DEGREES>1  SLANT  PATH  CALCULATION  XSC00320 

PLOT  WRITE  SLANT  PATH  EXTINCTION,  AT  INPUT  WAVELENGTH,  AND 

ALTITUDE  TO  NPLOTU  <SEE  COMMON  BLOCK  lOUNIT):  THE 
FIRST  RECORD  WILL  BE  THE  HUMBER  OF  POINTS  TO  BE  WRITTEN. 

FORMATS!  RECORD  t  <I5),  SUBSEQUENT  RECORDS  < 2< El  0 , 4 , 1 X  )  > 

GO  SIGNIFIES  TO  BEGIN  EXECUTION,  NO  MORE  INPUT  FOR  XSC.00330 

THIS  CALL.  NOTE  THAT  IF  A  DATA  CARD  IS  NOT  READ  XSC00340 

THEN  ANY  VALUES  ESTABLISHED  FROM  PREVIOUS  CALLS  XSC00350 

TO  THE  MODULE  ARE  STILL  IN  EFFECT.  XSC003b0 

ALL  THE  FOLLOWING  FOG  TYPES  ARE  RELEVANT  TO  HORIZONTAL  PATHS, 

BUT  ONLY  FOG  TYPES  1,  2,  OR  3  ARE  ALLOWED  FOR  SLANT  PATH  CALCULATIONS 
FOG  TYPE-1 .  FOR  MARITIME  ARTIC  XSC00380 

=2.  FOR  MARITIME  POLAR  XSC00390 

=3,  FOR  CONTINENTAL  POLAR  YSC00400 

=4.  FOR  RAIN  XSC00410 

=5.  FOR  SNOW  XSC 00420 

HORDIS  -  HORZONTAL  DISTANCE  IN  KM.  XSC00430 

SLTDIS  -  SLANT  PATH  DISTANCE  IN  KM,  XSC00440 

ANG=  LOOK  ANGLE  FROM  HORIZONTAL  IN  DEGREES  XSC00450 

N.B.  ONE  OF  THE  FOLLOWING  COMBINATIONS  MUST  BE  SUPPLIED  XSC00460 

FOR  SLANT  PATH  CALCULATIONS.  XSC00470 

HORDIS  AND  ANG  *■»  OR  *’*  SLTDIS  AND  ANG  XSC00480 

OUTPUT  XSC 005 00 

TRANSMISSION  AT  APPROPRIATE  WAVELENGTH  FOR  SLANT  OR  HORIZONTAL  PATHXSC00510 

XSC00520 

COMMON  XCONSTXPI ,PI2,PIRAD,TW0PI,T0RRMB,CDEGK  XSC00530 

COMMON  XIOUNITXIOIN, lOOUT, IPHFUN, LOUNI T , NDIRTU , NCL IMT , KSTOR , NPLOTUXSCO 0540 
COMMON  /'GEOMETXPTS<  15),  IGEOSW  XSC00550 

DIMENSION  TYPE<6),DAT<6)  XSC00560 

LOGICAL  NOLO  XSC00570 

DATA  TYPE  X4HF0G  , 4HH0RZ,4HSLNH, 4HSLNS, 4HPL0T, 4HG0  X  XSC00580 

DATA  AO, A1,A2,NPLT/0. 1425, 0.1475, -0.0017,0/  XSC00590 

USE  VIS-88.,  OR  89.  AS  AN  INDICATOR  THAT  XSCALE  HAS  BEEN  CALLED  XSC00600 
AS  A  SUBROUTINE  FROM  OTHER  PROGRAMS  -  NOT  EOMAIN!  XSC00610 

IF  <VIS.LT.87,9,0R,VIS.GT.89,1 )  GO  TO  8  XSC00620 

ANG-ANGLE  XSC00630 

C  FIND  ELEVATION  ANGLE  FROM  ZENITH  ANGLE  IN  SPOT  AND  LOWTRAN  XSC00640 
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AO  ojo  Kio 


IF  <VIS.GT.87.9.AND, VIS.LT.88. 1 >  rtNC-90 . -ANGLE 

IF  < VIS.GT.87.9, AND. VIS.LT.88. 1 .ANO.ANGLE.GT.90. >  ANG-ANGLE-90 . 
HORDIS=0. 

SLID  1 3=0, 

H0L0= . FALSE . 

C  ISLT=0=HORI20HTAL:  ISLT  GT  0  =  SLANT. 

IF  <ISLT.EQ,0>  H0RDIS=RANGE 
IF  < ISLT.EQ. 0;  ISLANT=0 
IF  <ISLT.GT.O;  SLTDIS=RANGE 
IF  < ISLT.GT. 0;  ISLANT=1 
GO  TO  6 

8  CONTINUE 

N0L0= . TRUE , 

DO  9  1=1,3 

READ  <IOIN,500>  < DAT< J > , J= 1 , 5  ) 

IF  <DAT< 1 >.EQ,TYPE< 1 >)  GO  TO  1 
IF  <  DAK  1  >  .  Eu  .  TYPE<  2  >  )  GO  TO  2 
IF  <DAT< 1  ),EQ.TYPE<3;)  GO  TO  3 
IF  < DAT< i > . EO . TYPE< 4  )  )  GO  TO  4 
IF  <DAT<:  1  >.EQ.TYPE<5i>  GO  TO  5 

IF  < DAT< i > . Eu ■ TYPE< 6 > >  GO  TO  6 

C  ERROR  CHECK 

GO  TO  7 

C  ADVERSE  WEATHER  INDICATOR  AND  OPTIONAL  RAIN  RATE: 

I  IF0G=IFIX«.DAT<2;> 

RNRT=DAT<3) 

GO  TO  9 

HORIZONTAL  DISTANCE  FOR  HORIZONTAL  PATH  CALC. 

H0RDIS=DAT<2> 

ISLANT=0 
GO  TO  9 

HORIZONTAL  DISTANCE  AND  ANGLE  FOR  SLANT  PATH  CALC. 

H0RDIS=DAT<2> 

ANG=DAT<3> 

ISLANT=1 
GO  TO  9 

SLANT  DISTANCE  AND  ANGLE  FOR  SLANT  PATH  CALC. 

SLTDIS»DAT<2> 

ANG=DAT<3) 

ISLANT=f 
GO  TO  9 
SET  PLOT  FLAG 
NPLT=f 
CONTINUE 
CONTINUE 

IF  <NOLO)  WRITE  <IOOUT,600> 

IF< IGEOSW.NE. 1 >GO  TO  88 

HORD  IS=SQRT<  <  PTS<  1  >-PTS<  4  )  )-*f2+<  PTS<  2  >-PTS<  5  >  >*=2  > 

SLTDIS-S£iRT<  H0RDIS'*"*2+<  PTS<  3  )-PTS<  6  )  >•**2  ) 

ANG=AC0S<;H0RDIS/'SLTDIS  )/PIRAD 
88  CONTINUE 
C  WAVELENGTH  ERROR  CHECK 

IF  <<WAVE.GT. . 4. AND. WAVE. LE. 2. > . OR . < WAVE . GE . 3 . . AND . WAVE . LE . 5 . > 
f  .0R.<WAVE.GE.8. AND.WAVE.LE. 12. 05)>  GO  TO  10 
WRITE  <100UT,1600;  WAVE 
IERR=1 
XSTRN=1 . 

RETURN 

10  CONTINUE 

IF  < NOLO. AND. IFOG.EQ. 1  )  WRITE  <IOOUT,800> 

IF  (NOLO. AND. IFOG.EQ. 2)  WRITE  <IOOUT,900> 

IF  <NOLO. AND. IFOG.EQ. 3)  WRITE  <IOOUT,950> 

IF  <NOLO. AND. IFOG.EQ. 41  WRITE  <IOOUT,1000> 

IF  < NOLO. AND. IFOG.EQ. 5)  WRITE  <IOOUT,1100> 

IF  < ISLANT.GT. 0)  GO  TO  1 1 
IF  <NOLO)  WRITE  <IOOUT,1200) 

II  IF  < NOLO. AND. ISLANT.GE. 1  )  WRITE  <IOOUT,  1400>  WAVE 

IF  < ISLANT.GE. 1 .AND. < IFOG.LE. 0, OR. IF0G.GE.4>>  WRITE  <IOOUT,2100) 
IF  < ISLANT.GE. 1 .AND. < IFOG.LE. O.OR.IFOG.GE.4>>  IFOG=1 
EXTN=EXT55 


XSCOOSSt: 
XSCOOSFf. 
XSCOObFu 
XSCuuSy u 
XSC00690 
XSC00700 
XSC00_ i 0 
XSCOOf  2  0 
X3C 00750 
XSC 00740 
X3C00750 
XSC 00760 
XSC 00770 
XSC007S0 
XSC00790 
XSC00800 
XSC 0081 0 
XSCOuSgO 
XSCOOSjO 

XSC 00840 
XSC00850 
XSCOOSbO 
XSC 008 70 
XSC 00880 
XSC00S90 
XSC0090U 
XSC 0091 0 
XSC0  0'.V2  0 
XSC00930 
XSC 00940 
XSC 00950 
XSC00960 
XSC00970 
XSC 00980 
XSC 00990 
XSC 01 000 
XSC  01010 
XSC 01 020 
XSC 01 030 


XSC 01 040 
XSC 01 050 
XSC 01 060 
XSCOl 070 
XSC 01 080 
XSCOl 090 
XSCOl 1 00 
XSCOl 1 1 0 
XSCOl 120 
XSCOl *30 
XSCOl 140 
XSCOl 150 
XSCOl 160 
XSCOl 170 
XSCOl 180 
XSCOl 190 
X3C0121 0 
XSCOl 220 
XSC01230 
XSC01240 
XSC 01 250 
XSCOl 200 
XSC 01 260 
XSC01270 
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IF  <  IbLANT.GE.1  .ANO.Uf^VE.GE.  .8>  CO  TO  101 
i  IF  < ISLAHT.GE. 1  )  CALL  SLANT< EXTN, HORDIS. SLTDIS , ANC , AVEX55 , lERF , 

1  WAVE,NPLT) 

IF  < lERR.EQ. 1  )  XSTRN  *t . 

IF  < lERR.EQ. 1 >  RETURN 
EXTN=EXT55 

IF  < ISLANT .GE. 1  )  EXTN=AVEX55 
XSPhTH=HORDIS 

IF  <  I3LANT.GE. 1 >  XSPATH=SLTDIS 
IF  < ISLANT.EQ. 0>  CO  TO  100 
SLANT  PATH  EXTINCTION 
XSTRN  =EXP<-XSPATH*EXTN) 

IF  <NOLO>  WRITE  <IOOUT,1500>  WAVE, EXTN, XSPATH, XSTRN , ANG 
RETURN 

jO  IF  (IF0G.NE.4>  GO  TO  101 
RAIN  -  ALL  WAVELENGTHS 

IF  < NOLO. AND. RNRT. LE. 0. 0)  WRITE  <IOOUT,550) 

IF  <RNRT.LE.0.0>  RNRT=1 . 

RNEXTN=A0+A1  >t‘RNRT+A2’t'RNRT#>»2 
XSTRN  =EXP<-XSPATH*RNEXTN) 

IF  <NOLO)  WRITE  <100UT,1550)  RNRT, RNEXTN, XSPATH, XSTRN 
RETURN 

101  IF  < ABS< WAVE- 1 . 06 j . LT . . 01 >  GO  TO  400 

IF  <WAVE.GE.3. .AND.WAVE.LE.S. >  GO  TO  200 
IF  < WAVE . GE . 8 . . AND .WAVE . Lt . 1 2 . >  GO  TO  300 
X8TRN=EXP< -XSPATH^EXTN  > 

RETURN 

200  CONTINUE 

3.0  TO  5.0  RANGE 
HA 

IF  UFOG.EQ.O  EXT35=»10, **<0, 0345+1 ,03*ALOG10<EXTN>> 

HP 

IF  UF0G,EQ.2)  EXT35-1  0  -0 . 38+1  . 32fAL0G  1  0<  EXTN  >  > 

CP 

IF  <IF0G.EQ.3>  EXT35»10.*>+(-0,82+1  .58*ALOG10<EXTN)> 
IF<IF0G.NE.5)  EXTN-EXT35 
IF  < ISLANT.GE. 1 >  GO  TO  12 
SNOW 

IF  <IF0G.EQ.5)  EXT35=«10.0h.»<1 .05+ALOG10<EXTN>+,021  ) 

XSTRN  =EXP<-XSPATH*EXT35) 

IF  <NOLO)  WRITE  <IOOUT,1700)  EXT35. XSPATH, XSTRN 
RETURN 

300  CONTINUE 

8.0  TO  12.0  RANGE 
HA 

IF  <IFOG.EQ,1)  EXT8t2-1  0.‘*+<-.45+l  .  19*AL0Gt  0<EXTN>> 

HP 

IF  <IF0G.EQ.2)  EXTei2=10.*>K-l  .01  +  1 ,5I*ALOG10<EXTN>> 

CP 

IF  <IF0G.EQ.3)  EXT812»10.**<-1 .65+1  .82i'ALOG10<EXTN>> 

IF< IFOG.NE .5i  EXTN=EXT812 
IF  < ISLANT.GE. 1 >  GO  TO  12 
SNOW 

IF  <1F0C,EQ.5>  EXT812=>10,0+*<  .993>»ALOG10<EXTN)+.  114> 

XSTRN  =EXP<-XSPATH*EXT812 j 

IF  <NOLO>  WRITE  <IOOUT,1800)  EXT81 2, XSPATH, XSTRN 
RETURN 

400  CONTINUE 
1  06  RANGE 
HA,  HP,  AND  CP 

EXT1 06-AHlN1< 1 0.»*<-0. 14+1 . 16+AL0G1 0< EXTN > >, EXTN ) 

EXTN=EXT1 06 

IF  ( ISLANT.GE. 1 >  GO  TO  1 2 

SNOW  -  ASSUHE  THAT  THE  EXTINCTION  AT  1.06  IS  THE  SAHE  AS  AT  .55 
IF  <IF0G.Ea.5)  EXT106-EXT55 
XSTRN  =EXP<-XSPATH*EXT1 06) 

IF  <NOLO>  WRITE  <IOOUT,  1900)  EXT  1 06, XSPATH, XSTRN 
RETURN 

WRITE  <I0OUT,2000)  < DAT< J ), J-1 , 4 > 

XSTRN- 1 , 


XSC01280 
XSC01290 
XSC01300 
XSC0131 0 
XSC01320 
XSCul 330 
XSC01340 
XSC01 350 
XSC01360 
XSC01 370 
XSC01380 
XSC01 390 
XSC01400 
XSC  01410 
XSC01420 
X3C01430 
XSC 01 440 
XSCOi 450 
XSCOl 460 
XSC01470 
XSCOI 480 
XSCOI 490 
XSCOI 500 
XSCOI 51 0 

XSCOi 520 
XSC01530 
XSCOI 540 
XSC01550 
XSC01560 
XSC 01 570 
XSCOI 580 
XSC 01 590 
XSCOI 600 


XSC0161 0 
XSCOI 620 
XSC01630 
XSCOI 640 
XSC01650 
XSCOI 660 
XSC01670 
XSCOI 680 
XSC01690 
XSCOI 700 
XSC0171 0 
XSC01720 
X3C01730 


XSC 01 740 
XSC01750 
XSCOI 760 
XSC01770 
XSCOI 780 
XSC 01 790 
XSC01800 
XSCOI 81 0 


UHXSC01870 
XSCOISdO 
XSC01890 
XSCOI 900 
XSC0191 0 
XSC01920 
XSC01930 
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Rl^IH  RATE  IS  .LE.  0.0,  RAIN  RATE 


IERR=1 
RETURN 

500  FORMAT  <A4,6X,5<F6 .2, fX)) 

550  FORMAT< 1H0,50HXSCALE  WARNING 
+  20HSET  EQUAL  TO  1  MM.-’HR,/') 

600  FORMAT  <1H  ,///, 1 X , SOX , 1 4H0PT IONS  CHOSEN > 

800  FORMAT  <1H  ,  SOX ,  1 4HMAR IT IME  ARTIO 
900  FORMAT  <1H  , SOX , 1 4HMAR I  TIME  POLAR > 

950  FORMAT  <1H  , SOX , 1 7HC0HTI NENTAL  POLAR) 

1000  FORMAT  <1H  ,50X,4HRAIN) 

1100  FORMAT  <1H  ,50X,4HSNOW) 

1200  FORMAT  <tH  , 5 OX . 1 5HH0R I20HTAL  PATH/) 

1400  FORMAT  <1H  , SOX , 1 SHSLANT  PATH  FOR  .F8.3,8H  MICRONS/) 

1500  FORMAT  < 1 X, 23X, 20HSLANT  EXTINCTION  AT  ,F5.2,8H  MICRONS, 

1  4X,  1 1HDISTANCE  , 1 2HTRANSMISSI0N, 6X , 5HANGLE/ , 1 X , 40X , 

2  26HKMt<*-1  KM,/ 

3  , 1X,38X,F8.3, 1 2X, F8 . 3, SX, E9 . 3, 7X, F? . 2 ) 

1550  FORMAT  <1H  , 20X , 27HEXT INCT I  ON  FOR  RAIN  RATE  0F,F5.2,6H  MM/HR, 
1  5X,  1 1HDISTANCE  , 1 2HTRANSMISSION/, 1 X, 4  0X, 


26HKMi"*-1  KM,/ 

1X,38X,F8,3, 12X,F8.3,3X,E9.3) 

<iH  ,l8H*>*'f+>t<  WAVELENGTH  <,F9.3,10H)  OUTSIDE  . 
tOHALLOWABLE  , 29HRANGE  <1.06,3.0-5.0,8.0-12.0 
31HM1CR0NS)  -  CONTROL  RETURNED  TO  , 

17HMAIN  FROM  XSCALE . ) 

<1H  ,25X,37HEXTINCTI0N  FROM  3.0  TO  5.0  MICRONS 
1 1HDISTANCE  , 1 2HTRANSMI SSION/, 1 X, 4  OX , 

26HKM**-1  KM,/ 

,  1  X , 38X , F8 . 3 , 1 3X , F8 . 3 . 5X , E9 . 3  ) 

<1H  ,25X,37HEXTINCTI0N  FROM  8.0  TO  12.0  MICRONS 
12H  DISTANCE  , 1 2HTRANSM1SSION/, 1 X, 40X, 

26HKM**-1  KM,/ 

, 1X,38X,F8.3, 12X,F8.3,5X,E9.3) 

<1H  ,25X,37HEXT1NCTI0N  AT  1.06  MICRONS 
1 IHDISTANCE  , 12HTRANSMISSION/, IX, 40X, 

2  26HKM**-1  KM,/ 

3  , 1X,38X,F8.3,12X,F8.3,5X,E9.3) 

2000  FORMAT  <1H  ,44HUNKNOUN  CARD  TVPE.  CONTROL  RETURNED  TO  MAIN, 
♦13H  FROM  XSCALE. ,/, 1X,A4,6X,5<F6.2, 1X>) 

FORMAT<1H  ,40HINCORRECT  FOG  TYPE  FOR  SUBROUTINE  SLANT,,/, IX, 
1  21HF0G  TYPE  CHANGED  TO  1/) 

END 


2 
3 

1600  FORMAT 
1 
2 
3 

1700  FORMAT 
1 

2 
3 

1800  FORMAT 
1 

2 
3 

1900  FORMAT 
1 


21  00 


XSC0194a 
XSC01 950 
XSCO 1 96t 
XSC01970 
XSC01980 
XSC01990 
XSC02000 
XSC020I 0 
XSC02020 
XSr:02  03  0 
XSC02040 
XSC02050 
X3C02060 
XSC02070 
X3C02030 
XSC02090 
XSC021 00 
XSC021 1 0 
XSC021 20 
XSC02130 
XSC02140 
XSC02150 
XSC02160 
XSC02170 
XSC02180 
XSC02190 
XSC02200 
XSC0221 0 
XSC02220 
XSC02230 
XSC02240 
XSC02250 
XSC02260 
XSC02270 
XSC02280 
XSC02290 
XSC02300 
XSC0231 0 
XSCC2320 
XSC02330 


XSC02340 
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SUBROUTINE  SLANT<EXT55 .HORDIS,SLTDIS,ANG, AVEX55, lERR , WAVE , HPLT  >  SLHT001 0 
COMMON  /lOUNlTr-'IOIN.  lOOUT,  IPHFUH,  LOUNIT ,  ND IRTU,  NCL I MT .  KSTOR ,  NPLOTUSLN  r  0 02 0 
COMMON  /CONST/PI ,PX2,PIRAD,TUOPI.TORR«B,CDEGK  SLNT0030 
RLL  QUANTITIES  IN  THIS  ROUTINE  ARE  FOR  .55  UM  SLNT0040 
REAL  KMTOM  SLNT0050 
KILOMETERS  TO  METERS  SLNT0060 
KMTuM=1000.  SLHT0070 
IERR=0  SLNT0080 
TOL=.0001  3LNT00S0 
IF  < HORDIS.lt. TOL.OR.ANG.lt. TOD  GO  TO  200  SLNT0100 
HORZuNTAL  DISTANCE  AND  ANGLE  INPUT  SLNTOHu 
VERDIS=»HORDIS*TAN<  ANG-oPlRAD)  SLNT0120 
SLTDi S=SuRT<  H0RDIS*>«2+VERD  IS'»*‘2  >  SLNTu f  30 
GO  TO  300  SLNTOMO 
IF  < 3LTDIS . LT . TOL . OR . ANG . LT . TOL >  GO  TO  500  SLNT0i50 
SLANT  DISTANCE  AND  ANGLE  INPUT  SLNTOfOO 
VERDIS=SLTDI3'*'SIN<  ANG^PIRAD  >  3LNT0  i  VO 
H0RDIS=3QRT<SLTDIS#’*2-VERDIS**2>  SLNT01S0 
CONVERT  TO  20  METER  INCREMENTS  SLNT0190 
VERDIS-FLOAT< IF  I X< < VERD I S+TOL )*KMT0MX2 0 .  >>*20. VKMTOM  SLNT0200 
LIMIT  ON  VERTICAL  HEIGHT  IS  500  METERS  SLNT021 0 
IF  <VERDIS*KMTOM.GT.500. >  VERDIS-. 5  SLNTn220 
3D=SQRT<HORDIS**2+VERDIS**2>  3LHT0230 
IF<SD^SLTDIS.GT. 1 . 01 . OR . SDVSLTDIS . LT . . 99 >WRITE< lOOUT . 700 >SLTDIS , SDSLNT0240 


351 

400 

C 


SLTDIS-SD 

FIND  NBR  OF  20  METER  INCREMENTS 
ITOP=IF1X<<VERDIS+TOL>*KMTOM/20. > 

IF< ITOP.LT. 1 >  lTOP-1 
VERDI3-FLOAT<  ITOP  >*20./'KMTOM 
EXTN-EXT55 

BEGIN  TRAPE20DIAL  INTEGRATION  FOR  TAU  <  OPTICAL  DEPTH) 
TAU-EXTNVa. 

ALT*0 . 0 
NPTS=ITOP*l 

IF  <NPLT.Efil.l>  WRITE  <NPL0TU,352>  NPTS 
FORMAT  < 15 > 

IF  <NPLT.EQ.1>  WRITE  <NPL0TU,351>  EXTN, ALT, WAVE 
DO  400  I»l,ITOP 

THESE  FORMULAS  ARE  GOOD  ONLY  IN  20M  INCREMENTS 
IF  <EXTN.GE,7.0,AHD,WAVE.LT.2.0>  EXTN- 
1  1 0.**< 0.55+0. 72*AL0G1 0<EXTN)> 

IF  <EXTN,LT,7.0.AND.WAVE.LT.2.0>  EXTN- 
1  10.**<0.1*1 .25*ALOG10<EXTN>> 

IF  <EXTN.GE.3.3.AND.<WAVE.GE.3.0.AND,WAVE,LT.5. 0>>  EXTN= 

1  10.**<0.55+.72*ALOG10<EXTN)> 

IF  <EXTN,LT.3.3.AND.<WAVE.GE.3. 0.AND.WAVE.LT.5. 0>>  EXTN= 

1  10.**<0.3+1 .2*ALOG10<EXTN>) 

IF  <EXTN.GE. 1 ,7.AND.<WAVE.GE.8. O.AND. WAVE.LT. 12. 0>>  EXTN= 
1  1 0.**< 0.5+0. 75*AL0G1 0<EXTH)> 

IF  <EXTN.LT. 1 .7. AND. <WAVE.GE. 8. O.AND. WAVE.LT. 12.0 >>  EXTN= 
1  1 0.**< 0.4+1 .2*AL0G1 0<EXTN)> 

ALT=FLOAT< I >*20. 

IF  <NPLT.EQ.1>  WRITE  <HPL0TU,351)  EXTN,ALT 
FORMAT  <3<E10.4,1X)) 

TAU-TAU+EXTN 

FINISH  TRAP  INTEGRATION 

TALt=<  TAU-EXTN/’2  .  )*  .  02 

FIND  AVERAGE  EXTINCTION  VALUE  FOR  SLANT  PATH- 

AVENSS-TAU/VERDIS 

RETURN 

WRITE  <IOOUT,600> 

IERR-1 

RETURN 


SLNT0250 
SLNT0260 
3LNT  02 1'  0 


SLNT0280 

SLNT0290 

SLNT0300 


SLNT031 0 
SLNT0320 
SLNT0330 
SLNT0340 
SLNT0350 
SLNT  0360 
SLNT0370 
SLNT0380 
SLNT 0390 
SLNT 0400 
SLNT041 0 
SLNT 0420 
SLNT0430 
SLNT 0440 


SLNT0450 
SLNT 0460 
SLNTy470 
SLNT0480 
SLNT0490 
SLNT 05 00 
SLNT051 0 
SLNT 0520 
9LNT0530 
SLNT0540 
SLNT0550 
SLNT0560 


3  FORMAT  <lX,3eHERR0R  -  IMPROPER  INPUT  FOR  SUBROUTINE  SLNT0550 

1  34HSLAHTI  TRANSMISSION  SET  EQUAL  TO  1>  SLNT0560 

FORMAT  <1H  ,18HWARNING  FROM  SLANT,/, 1X,22HTHE  VERTICAL  DISTANCE  ,  SLNT0570 
+38HEXCEEDS  THE  500  METER  UPPER  LIMIT,  OR  ,/,1X,10HIS  NOT  AN  ,  SLNT0580 

+29HINTEGER  MULTIPLE  OF  20  METERS,/, IX, 28HSLANT  DISTANCE  CHANGED  FRSLNT0590 
+OM  ,F7,4,4H  TO  ,F7,4,3H  KM/)  SLNT0600 
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oooooonooooooooooooooriooooooooorioooooooooooooooooooooooooooonooriooooo 


SUBROUTINE  TURB< WhVE , lERR > 

CALCULATES  TURBULENCE  INDUCED  POINTING  JITTER  AND  POWER  SPECTRUM 
ECiR  LASER  TARGET  DESIGNATOR  AND  TERMINAL  HOMING  SEEKER 

%  Ik  « ■!<  X<  «•  >k  ■«  « ><<  >l>  I*  m  Ik  «  W  I)  <*  *  *  4i  Hull  *  *  4t  Hi  Hi  ililli «  4i «  4f  >)■  >(■  1|I  ^  If  iti «  4)  4c  !)>  initi «  « 111 «  >ti 

CALCULATION  FOR  THE  DESIGNATOR  PATH  ARE  PERFORMED  EACH 
TIME  THIS  ROUTINE  IS  REFERENCED.  THE  CALCULATIONS  FOR  THE 
SEEKER  PATHS  ARE  PERFORMED  ONLV  WHEN  THE  DATA  CARDS  DVRVc 
CN2,  OR  V2  ARE  INCLUDED  IH  THE  INPUT  SET. 

THE  INPUT  IS  CARD  ORDER  INDEPENDENT,  WITH  THE  SINGLE 
RESTRICTION  THAT  THE  'GO'  CARD  MUST  BE  THE  LAST  CARD 
OF  THE  DATA  SET. 

THE  DATA  IS  COMPLETELY  IDENTIFIED  BY  THE  ID  IN  COLUMNS 
1-4  OF  EACH  CARD,  FOLLOWED  BY  UP  TO  7< REAL >  FIELDS  AS 
NEEDED,  WITH  10  COLUMNS  PER  FIELD  BEGINNING  IN  COL,  il, 
COMMENTS  BELOW. 

THE  INPUT  FORMAT  IS  A4 , 6X, 7< Ei 0 , 4 > 

THE  INPUT  OF  A  CN1 ,  CN2,  VI  AND  V2  TYPE  DATA  CARD  IS 
TERMINATED  WHEN  THE  FIRST  COEFFICIENT  OF  VALUE  ZERO 
IS  ENCOUNTERED.  THE  REMAINING  DATA  COEFFICIENTS  ON 
THE  CARD.  IF  ANY,  ARE  IGNORED. 
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THE  FOLLOWING  ARE  REQUIRED  RECORDS  FOR  AT  THE  FIRST  INPUT  SET. 

IDENT.  VARS.  DESCRIPTION 


DIAM  LASER  TARGET  DESIGNATOR  APERTURE  DIAMETER  IN  METERS 
THET  LASER  BEAMSPREAD  ANGLE  IN  RADIANS 
TDOT  LASER  BEAM  SLUE  RATE  IN  RAD1AN57SEC0ND 
RANG  DISTANCE  FROM  DESIGNATOR  TO  TARGET  IN  METERS 

TIME  DURATION  OF  CALCULATIONS  IN  SECONDS 

M  NO.  OF  FREQUENCIES  FOR  WHICH  POINTING  JITTER  POWER 

SPECTRUM  IS  TO  BE  CALCULATED,  IF  M=0,  THEN  DEFAULT 
TO  M=512. 

4.4.4.RANG  AND  RIV  ARE  RECALCULATED  IF  IGEOSW-1 

4.4I4.N1  AND  N2  ARE  CALCULATED  WITHIN  THE  ROUTINE. 

N1  NO  OF  SEGMENTS  IN  DESIGNATOR  PATH 

N2  NO,  OF  SEGMENTS  IN  SEEKER  TO  TARGET  PATH 

N1  AND  N2  ARE  SET  EQUAL  TO  THE  INDEX  OF  THE  LAST  NON-ZERO 
COEFFICIENT  READ  INTO  CHI  AND  CN2  RESPECTIVELY. 

11 

IR2  STARTING  INDEX  VALUE  OF  CN1<I> 

<CN1<I),  I-IR2, IR2+5 > 

CNUI)  VALUES  OF  REFRACTIVE  INDEX  STRUCTURE  CONSTANT 

WITH  ONE  VALUE  FOR  EACH  SEGMENT  OF  RANGE  FROM  LASER 
DESIGNATOR  TO  TARGET  <  METERS4.4.< -2K3  >  ) 

I 

IR2  STARTING  INDEX  VALUE  OF  V1<I> 

<V1<I>,  I-IR2,IR2+5i 

V1<I)  SET  OF  VALUES  OF  CROSSWIHD  VELOCITY 

CORRESPONDING  TO  EACH  SEGMENT  OF  RANGE  FROM  LASER 
DESIGNATOR  TO  TARGET  < M/SEC > 

)VRV 

01 V  DIAMETER  OF  SEEKER  APERTURE  IN  METERS. 

RIV  SEEKER  RANGE  TO  TARGET  IN  METERS. 


STARTING  INDEX  VALUE  OF  CN2< I ) 


TUPOOOi 0 
TUR00020 
TUR00030 
TURti004  0 
TUR00050 
TUROOOSO 
TUR00070 
TUR00080 
TUR00090 
TUROOi 00 
TUROOl 1 0 
TUR00120 
TUR0U130 
TUR00140 
TUR00150 
TUR00160 
TUROOi  I'O 
TUR00180 
TUR00190 
TUR0CI20  0 
TUR0021 0 
TUR00220 
TUR00230 
TUR00240 
TUk00250 
TUR 00260 
TUR00270 
TUR00280 
TUR 00280 
TUR00300 
TUROOSi 0 
TUR 00320 
TUR00330 
TUR00340 
TUR00350 
TUR003S0 
TUR00370 
TUR00380 
TUR00390 
TUR00400 
TUR0041 0 
TUR00420 
TUR00430 
TUR 00440 
TUk00450 
T'JR00460 
TUR00470 
TUR00480 
TUR 00490 
TUR00500 
TUR0051 0 
TUR00520 
TUR 00530 
TUR00540 
TUR00550 
TUR 00560 
TUR0u570 
TUR00580 
TUR 00590 
TUR00600 
TUR0061 0 
TUR00620 
TUR00630 
TUR00640 
TUR00650 
TUR00660 
TUR00670 
TUR00680 
TUR 00690 
TUR00700 
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TUROO? ) 0 
TUROO'.’O 
TUR 00:30 
TUR00740 
TUR0075U 
TUR 00760 
TUkOO?.'  u 
TUR 0 0780 
TLiK0079u 
TUR 008 00 
TUR00S1 0 

NPPS  NONE  PRINTS  TABULAR  VALUES  OF  POWER  SPECTRUM  VS  FREQUENCE  TIJR00S20 

NPPJ  NONE  PRINTS  TABULAR  VALUES  OF  POINTING  JITTER  VS  TIME  TUR00830 

NPAL  NONE  PRINTS  TABULAR  VALUES  OF  BOTH  POWER  SPECTRUM  < P3 >  TUR0C640 

AND  POINTING  JITTER  <PJ>.  TuR0085u 

f*IF  TNIS  CARD  IS  MISSING  NO  TABLES  WILL  BE  PRINTED  ODEFAULT  VALUE >. TUR00860 

TUR 00870 

THE  FOLLOWING  IDENT  RECORD  IS  ALWAYS  REQUIRED. 


<CN2<  I  ), 
CN2<  I  ) 


IR2 
V2<  I  > 


I»IR2, IR2+5> 

VALUES  OF  REFRACTIVE  INDEX  STRUCTURE 

CONSTANT  FOR  EACH  SEGMENT  OF  RANGE  FROM  TARGET  TO 

SEEKER  <METERS**<-2/3)> 

STARTING  INDEX  VALUE  OF  V2< I ) 

VALUES  OF  CROSSWIND  VELOCITY  FOR  EACH  SEGMENT 
OF  RANGE  FROM  TARGET  TO  SEEKER  <M7SEC>. 


GO  SIGNIFIES  TO  BEGIN  EXECUTION  FOR  THIS  DATA  SET. 

AFTER  EXECUTION,  ANOTHER  SET  OF  INPUTS  MAY  BE 
READ-IN  FOLLOWED  BY  ANOTHER  'GO'  CARD. 

ANY  VALUES  ESTABLISHED  FROM  PREVIOUS  INPUT  SETS 
TO  THE  ROUTINE  ARE  STILL  IN  EFFECT.  THUS  DATA 
SUCH  AS  FROM  CARD  FARM  HEED  NOT  BE  READ  AGAIN  IF 
THERE  ARE  TO  BE  NO  CHANGES  IN  THE  DATA  ASSOCIATED 
WITH  THAT  IDENTIFIER. 

4i  Hi  1(1  m  4i  %  %  Id  tn  %  ^  41 *(<  >||  >•>  >0  41  >4*  41  %  41  ^  %  41  %  ^  >(< 

++  CALLED  PROGRAMS  ++ 

DESUB 

FALPH 

FFT4 

GAUSS 

MEANVR 

RAND 

SPECT 

SPREAD 

THETO 

♦ +♦++♦+++++++++++++♦+++++++♦♦++++++ ++♦+♦+♦♦♦♦♦♦ +♦+++++++++♦+ 

COMPLEX  RAN 
REAL  LAMB 

REAL  INR<7), IR1 ,LABEL< 11 > 

LOGICAL  SETUP 

COMMON  XCONSTXPI , PI2, PIRAD, TWOPI , TORRMB, CDEGK 


TUR008S0 
TUROOSSu 
TUR 009 00 
TUR0091 0 
TURC0920 
TUR00930 
TUR 00940 
TUk00950 
TUR00960 
TUR 009 70 
TUR 00980 
TUR00990 
TUROt  000 
TUR01 01 0 
TUR 01 020 
TUR 01 030 
TUR 01 040 
TUR01 050 
TUR01 060 
TUR 01 070 
TUR01 080 
TUR01 090 
TUR01 1 00 
TUR01 1 1 0 
TLIROI  120 
TUR01 140 
TUR01 150 
TUR01 160 


COMMON  /lOUNIT/IOlN, lOOUT, IPHFUN , LOUNIT , NDIRTU , NCL IMT , KSTOR , NPLOTUTUR 0 1 170 


C  SET 
C"*** 


THIS  IS  A  COMPLEX  NUMBER  EACH  NUMBER  TAKES  TWO  WORDS 
COMMON  XMO5/'RAN<2048> 

COMMON  XM01/’FR<  1  025  ) ,  CNI  <  20  >,  VI  <  20  >,FO<  20  >,  RO(  20  > 

COMMON  /'LOWEX,'PS<  1  025 ),V2<20>,RR<t0> 

DIMENSION  CN2<20),PJCHAR<4),PSCHAR<4) 

COMMON  /'GEOMET/'PTS<  15),  IGEOSW 
EXTERNAL  DESUB, FALPH 
DATA  SETUPS. TRUE. 7 

DATA  PJCHAR,PSCHAR  X4HPJ  <  ,4HRAD>»',4H>*2/S,4HEC  >  ,4HPS  <,4HRAD», 

4Hi>27H,4HZ)  / 

DATA  LABEL/’4HG0  ,  4H  ,4HPARM,4HCN1  ,4HV1  ,  4HDVRV,  4HCN2  , 

4HV2  ,4HNPPS,4HNPPJ,4HNPAL7 

NPRINT=0 

LAMB-WAVE 

THE  SEED  FOR  THE  RANDOM  NUMBER  GENERATOR 
NOTE,  THIS  SEED  IS  APPROPRIATE  FOR  THE  RANDOM  NUMBER  GENERATOR 
USED  AT  THE  ATMOSPHERIC  SCIENCES  LAB.  USERS  AT  OTHER 
INSTALLATIONS  WILL  NEED  TO  SUPPLY  THEIR  OWN  RANDOM  NUMBER 
GENERATOR. 

IF  < .NOT. SETUP)  GO  TO  100 
VARX-735. 34829 
VARX-RAND< VARX > 

SETUP-. FALSE. 
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TUR01 180 
TUR01 190 
TUROI 200 
TUR01 21 0 
TUR0t220 
TUR01230 
TUR01240 
TUR01250 
TUP 01 260 

TUR01270 
TUR01280 
TUR01290 
TUR01300 
TUR0131 0 
TUROI 320 
TUR 01 330 
TUR01340 
TUR01350 
TUR01360 
TUR 01 370 
TUR01380 
TUROI 390 
TURCt4C<0 


IOPT=i 

TUR'''i41  0 

1  00 

READC  I01N,300Ci>  IR1,<INR<n,  1*1. 7> 

TURol 420 

IR2*IFIX< INR< 1 >> 

TUR01430 

IF< IRI ,EQ.LABEL< 1 >>  GO  TO  180 

TUR01440 

IF< IRl ,EQ,LABEL<3 GO  TO  110 

TUR01450 

|F< IR1 ,EQ,LABEL<4))  GO  TO  120 

TUR01460 

IF< IR1 .Ee.LABEL<5>>  GO  TO  130 

TURO‘470 

IF< IR1 .EQ.LABEL<6>>  GO  TO  140 

TUR01480 

IF<  IR1  .EGi.LABEL<7  j>  GO  TO  150 

TUR01 450 

IF< IR1 .EQ.LABEL<8))  GO  TO  160 

TURC1500 

PRINTING  OPTIONS 

TUROISI 0 

IF< IR1 .EQ,LABEL<9>>  NPRINT=1 

TUROI 520 

IF<IR1 .EQ.LABEH 10>>  NPRINT-2 

TOkOI 53o 

IF< IR1 .EQ.LABELt 1 1 >)  NPRINT=3 

TUROf  54  0 

1F<NPRINT.EQ.  1  .0R.NPRINT.EGi.2.0R.NPRINT.EQ.3>  GO  TO  100 

TUk01 5s0 

WRITE< IOOUT.3O01 >  1R1,<INR<I).  1-1. 7> 

TUROI 560 

GOTO  100 

TUR01570 

TUROI 580 

1  i  0 

DIAM  =  INR<1> 

TUROiSSO 

THET  =  INR<2) 

TUROI 600 

TDOT  =  iNft<!3; 

TUROI 61 0 

RANG  =  INR<4.') 

TUROI 620 

TIME  =  INk<5) 

TUROI 630 

M  -  1FIX< 1NR<6)> 

TUROI 640 

IF<M  .Eu.  0;  M  -  512 

TUR01650 

GOTO  100 

TUR01660 

TURu1670 

120 

DO  125  1=2.7 

TUROI 680 

IF< INR<I  ),NE.0.0)  GOTO  121 

TUR01690 

N1-IR2-1 

TUROI 700 

GOTO  100 

TUR0171 0 

121 

CNH  IR2>-INR<  1  > 

TUR01720 

IR2-IR2+1 

TUR01730 

IF<IR2  .GT.  20 >  GOTO  126 

TUROI 740 

125 

CONTINUE 

TUR01750 

126 

IR1-IR2-1 

TUR01760 

N1=MAX0<N1 , IFIX< IR1  >) 

TUR01770 

GOTO  100 

TUR01780 

TUR01790 

130 

DO  131  1-2.7 

TUR01800 

V1< 1R2>»INR<  I  ) 

TUR0181 0 

IR2-IR2-M 

TUR01S20 

IF< 1R2  .CT.  20)  GOTO  1 00 

TUR01830 

131 

CONTINUE 

TUR01S40 

GOTO  100 

TUR01850 

T'IR01S60 

140 

lOPT  =  2 

TUR01S70 

D1V  =  INR< 1  ) 

TUROI 880 

R1V  =  INR<2) 

TUR01 890 

GOTO  100 

TUR01900 

TUROI 91 0 

150 

lOPT  =  2 

TUR01920 

DO  155  1-2.7 

TUROI 930 

IF< INR< I  ).NE. 0. 0)  GOTO  151 

TUR01940 

N2-IR2-1 

TUR01950 

GOTO  100 

TUROI 960 

151 

CN2< IR2>  -  INR< I ) 

TUR01970 

IR2-IR2-M 

TUR01980 

IF<IR2  .GT.  20)  GOTO  156 

TURO1990 

155 

CONTINUE 

TUR 02000 

156 

IR1-IR2-1 

TUR0201 0 

N2»MAX0<N2. IF1X< IR1 )) 

TUR02020 

GOTO  100 

TUR02030 

TUR02040 

160 

lOPT  -  2 

TUR 02050 

DO  161  1-2,7 

TUR02060 

V2< IR2)  -  1NR( I  ) 

TUR02070 

IR2=IR2+1 

TUR02080 

IF< IR2  .GT.  20)  GOTO  100 

TUR02090 

161 

CONTINUE 

TUR 021 00 
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GOTO  1 00 

c 

130  IF<  IGEOSU.NE.  OGO  TO  190 

RANG-SQRT<  <  PTS<  ?  >-PTS< 1  >  PTS<  8  )-PTS<  2  >  )**2* 

+< PTS<  9  >-PTS<  3  > i**2 ) 

DISKTM=t  000. 0 

rpng=rpng*disi«:tm 

R1  V=SQRT<  <  PTS<  4  >-PTSi:  1  >  >**2+<  PT3<  5  >-PTS<  2  >  PTS(  8  :>-PTSt;  3  >  )**2 

R1V=R1V*DISKTH 
190  CONTINUE 

IF  <LPHB .LE. 14. >  GO  TO  200 
WRITE  <IOOUT,2500)  LAMB 
IERR=1 
RETURN 

200  WRITE  < I00UT,31 00) 

IF  <I0PT.EQ.2)  WRITE  <IOOUT,3200) 

WRITE  <IOOUT,3300)  L AMB > D1 AM , THET 
C  CHANGE  WAVELENGTH  TO  METERS 
LAMB=LAMB21 . OE+6 

IF  <I0PT.E0.2>  WRITE  <IOOUT,3400>  01V, R1V 

WRITE  <IOOUT,3500)  TOOT, RANG 

WRITE  <IOOUT,3600)  TIME 

WRITE  <  IOOUT,3700:)  N1 

IF  <I0PT.EQ.2>  WRITE  <IOOUT,3800>  N2 

WRITE  < IOOUT,3900>  M 

WRITE  <IOOUT,4000) 

WRITE  <  IOOUT,4200) 

00  400  1=1 ,N1 

WRITE  <IOOUT,430O)  1 , CN1 < I >, VI < 1) 

400  CONTINUE 

IF  <  lOPT.EQ. 1  )  GO  TO  600 
WRITE  <IOOUT,4100) 

WRITE  <IOOUT,4200) 

00  500  1=1 ,N2 

WRITE  <IOOUT,4300)  I , CN2< I ),  V2< 1 > 

500  CONTINUE 

C  COMPUTATION  OF  TIME,  FREQUENCY  ANO  SPATIAL  INCREMENTS 
600  DELT-T1ME2M 
OELF=l ./TIME 
OELZ=RANG/FLOAT<N1 ) 

IF  <N2.NE.O)  DEL1V-R1V/FL0AT<N2> 

MM=M+M 

M1=M+I 

MM1=MM+1 

MM2=MM+2 

MSCi=SQRT<  FLOAT<  MM  )  > 

00  700  I»2,M1 
FR< I  )=< 1-1  >#DELF 
700  CONTINUE 

R2-0IAM/THET 

R«RANG+R2 

OT=THET*RANG 

02»OIAM+OT 

C  COMPUTATION  OF  EFFECTIVE  WINO  VELOCITY,  COHERENCE  LENGTH  ANO 
C  NORMALIZATION  FREQUENCY  FOR  EACH  SEGMENT  OF  PATH  FROM  LASER 
C  DESIGNATOR  TO  TARGET 
ZI«0. 0 
Z1-0ELZ/2. 

ROT=0, 0 
OEL=0. 0 
DO  800  1=1 ,N1 
ZI-Zl+ZI 
Z1-0EL2 

VEI=V1< I  )+TD0T*<ZI-R2> 

RO<  I  >»16.71*0EL2'*>CN1<  I  >■»<  1  . -Z  I/RANG  >*♦!  .  66667/<  LAMB-oLAMB  > 

FO< I >= VE I /< P I fOa^Z I /R > 

ROT=ROT+RO< I > 

OEL*OEL+OELZ*CN1<  1  )h.<RANG-ZI  >/RANG 
RO<  I  >=RO<  I  )■»*<  -  .  6  > 

800  CONTINUE 


u 


TUR02t 
TURO.'l) 
TUft02', 
TUR021  <4u 
TURr.21  5u 
TURL'';  1  t  C' 
Tl'.R  ul  ,  I  0 
>TUR02)h,-. 
TuROil 90 
TUR02200 
TUR0221 0 
TLIR  0222  0 
TUR 02230 
TUR 02240 
TUR022t.  0 
TUR02260 
TUR02270 
TUR 02280 
TijR02290 
TUR02300 
TUR0231 0 
TUR02320 
TUR02330 
TUR02340 
TUR 02350 
TUR 02360 
TUR02370 
TUR02380 
TUR02390 
TUR02400 
TUR024 i 0 
TUR 02420 
TUR  0243:' 
TUR02440 
TUR02450 
TUR02460 
TUR02470 
TUR02480 
TUR 02490 
TUR 025 00 
TUR 0251 0 
TUR 02520 
TUR 02530 
TUR 02540 
TUR02550 
TUR 02560 
TUR  0257  0 
TUR 02530 
T'JR02?9  0 
TUR02600 
TUR 0261 0 
TUR02620 
TUR02630 
TUR 02640 
TUR 02650 
TUR 02660 
TUR02670 
TUR 02680 
TUR02690 
TUR 027 00 
TUR0271 0 
TUR02720 
TUR02730 
TUR 02740 
TUR02750 
TUR 02760 
TUR 02770 
TUR 02780 
TUR  1.2790 
TUR  0  28  0  0 
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R0T=R0T>»*<  -  .  6  >  TijKC'28tu 
CALL  SPREAD< DI AM, ROT, LAMB, THET, RANG, DRO, THETOL, DOL , THET1 2 , 0 1 2 ,  TUP  0282  0 
1  DTHET,D22>  TUR02830 
WRITE  <IOOUT,4500)  R2,R  TUR02840 
WRITE  < IOOUT,460O>  ROT , DRO , THET, DT, THETDL , DDL , THET 1 2 , D 1 2 , DTHET , 022TUR 0285 0 


WRITE  <IOOUT,4700)  TUR02360 

DO  1000  1=1, N1  TUR02870 

1  000  WRITE  <IOOUT,4800)  I , RO< I  ) , FO< I >  TUR02880 

COMPUTATION  OF  ANGLE  OF  ARRIVAL  POWER  SPECTRUM  OF  LASER  DESIGNATOR  TUR02890 
F2=0.  TUR02900 

PS<1)=0.  TUR029i0 

DO  1100  J=2,M1  TUk02920 

F=FR<J)  TUR02930 

F1=0.  TUR 02940 

CALL  SPECTc F, D2, N1 , FI , LAMB >  TUR02950 

PS<0>=F1  TUR02960 

IF  <IOPT.EQ.1>  P3<  J>=F1*<D2/'DIAM>'»*2  TURu2970 

F2=F2+P3< J >*DELF  TUR02980 

it  00  CONTINUE  TUft02990 

IF  <IOPT,EQ.1>  WRITE  <IOOUT,4400>  F2  TUR03000 

F2SGIRT=SQRT<F2)  TUR03010 

AJITT=F2SClRT*RANG  TUR03020 

IF  <IOPT.EQ.1>  WRITE  <IOOUT,4900>  F23GRT,AJITT  TURu3030 

IF  <IOPT.EQ.1>  GO  TO  1500  TUR03040 

;  TUR03us0 

DTV=THET*R1 V  TUR03060 

COMPUTATION  OF  EFFECTIVE  WIND  VELOCITY,  COHERENCE  LENGTH  AND  TUR03070 

NORMALIZATION  FREQUENCY  FOR  EACH  SEGMENT  OF  PATH  FROM  TUR03030 

TARGET  TO  SEEKER  TUR05090 

21=0.  TUR03100 

21=DEL1V/‘2.  TUROSiiO 

ROT=0,0  TUR03120 

DO  1200  1=1, N2  TUR03130 

21=21+21  TUR03140 

21=DEL1V  TUR03150 

Vei=V2< 1 >+TDOT*<R1  V-2I  >  TUR03160 

RO<  I  )=16.714.DEL1  V*CN2<  I  >•*■<  ZIz-RI  V  )**1  . 66667A  LAMB+LAMB  >  TUR03170 

ROT=ROT+RO< I  )  TUR03180 

RO(  I  )=R0<:  I  .  6  >  TUR03190 

FCK  I >=VEI2<PI+D1V*ZI2R1V>  TUR 032 00 

1200  CONTINUE  TUR03210 

R0T=R0T+>*'<-.6)  TUR03220 

CALL  SPREADS D22, ROT, LAMB, THET, R 1V,DRO,THETDL, DDL, THET1 2, D1 2, DTHET, TUR 03230 


DESIGNATOR 


1  D22V)  TUR03240 

WRITE  < lOOUT, 4550)  TUR03250 

WRITE  <IOOUT,4600)  ROT , DRO , THET, DTV , THETDL, DDL , THET 1 2 , D 1 2 , DTHET ,  TUR03260 

1  D22V  TUR03270 

WRITE  < lOOUT, 4700)  TUR03280 

DO  1300  1=1, N2  TUR03290 

1300  WRITE  <IOOUT,4800)  I , RO< I  ) , FO< I  )  TURC3300 

COMPUTATION  OF  TURBULENCE  INDUCED  POINTING  JITTER  POWER  SPECTRUM  TUR03310 

FROM  TARGET  SPOT  TO  LASER  SEEKER,  COMPUTATION  OF  TOTAL  POWER  TUR03320 

SPECTRUM  FROM  LASER  DESIGNATOR  TO  SEEKER  AND  POWER  SPECTRUM  VARIANCE  TUR03330 


ChLL  THET0<  THETAO , FALPH, CN2 , D 1 V , R1 V, N2  > 

F2=0. 

DO  1400  J=2,M1 
F=FR<  J) 

F1  =  0. 

CALL  SPECT<F,D1V,N2,F1 ,LAMB) 

PS<  J)=PS':  J>+F1/<  1  ,+<D22<R1  V>i«THETA0>)**2> 

P5<  J  >=PS<  J  >*<  D27D1  V  )>i"»2 
F2=F2+PS<  J>H'DELF 
1400  CONTINUE 

WRITE  <IOOUT,4400>  F2 

1500  IF  <NPRINT.EQ. 1 .0R.NPRINT.EQ.3)  WRITE  <IOOUT,5000>  DELF 


FREQ=0. 0 
FINC=DELF4'1  0. 0 
IF  <NPRINT,EQ. 1 
IF  <NPRINT.EQ. 1 
K=1 


0R,NPRINT.E0.3)  WRITE  <IOOUT.5600> 
0R.NPRINT.EQ.3)  WRITE  <IOOUT,5800)  PSCHAR 


TUR03340 
TUR03350 
TUR 03360 
TUR03370 
TUR033S0 
TUR03390 
TUR03400 
TUR0341 0 
TUR03420 
TUR03430 
TUR 03440 
TUR03450 
TUR03460 
TUR03470 
TUR03480 
TUR03490 
TUR03500 
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1 

L=1  0 

TUR035;  J 

1600  IF  <L.GT.M1 >  L=M) 

TUR0“t 

IF(NPR1NT ,EQ . 1  . OR , NPR I  NT . EQ . 3  )URrTE  < lOOUT, 2800  )FREe, <  PS<  J>,  J=K , 

L  )TUR03.,  ;  <j 

FPEQ=FREG+FINC 

TUR03540 

K  =  L+1 

TUR 03550 

L  =  K  +  9 

TUR075^:.h 

IF  cK.LE.MI)  GO  TO  1600 

TUP  035 / 0 

00  2400  L=1 / lOPT 

TURO-J-jS  0 

IF  <L.EQ.lj  URITE  <100UT,5100) 

TUR0359D 

IF  <L.EQ.2>  WRITE  <IOOUT,5200) 

TUR03600 

C  GENERATION  OF  RANDOM  SEQUENCE  HAVING  SAME  POWER  SPECTRUM  VARIANCE 

TUR036 1 0 

C  AS  INDUCED  BY  TURBULANCE .  ADD  SYMMETRIC  TERMS  FOR  NEGATIVE 

TUR 03620 

C  frequencies,  compute  mean  and  VARIANCE  OF  RANDOM  ARRAY 

TUR0j6.i0 

RAN< 1  >=<  0 . , 0 .  > 

TUR03640 

DO  1700  1=2, Ml 

TUR0365CI 

MMM=MM2-I 

TUR03660 

C  GENERATE  RANDOM  NUMBER  WITH  ROUTINE  GAUSS 

TURl'36,-  0 

C  NORMAL  DISTRIBUTION 

TUR076F.0 

C  MfcAN  =  0 . 0 

C  STANDARD  DEVIATION  =1.0 

C  REAL  PART  -  RANDOM  NUMBER 

TUKtij.6'?0 

TUR03700 

TUR0371 u 

C  IMAG  PART  =  0 

TUR03720 

kAN<  I  >=CMPLX(  GAUSS<  12, 0.0, 1.0), 0.0  >'»SQRT<:  PS<  I  )/D£LT  ) 

TUROj/ju 

raN';mmm>=ran<  i  > 

TURC3740 

1700  CONTINUE 

TURu3,' jO 

C  CALCULATE  POWER  OF  2  ,NPOW,  FOR  FFT4  SINCE  ARRAY  PASSED  TO 

TUR03760 

C  FFT4  MUST  HAVE  SIZE  THAT  IS  A  POWER  OF  2.  <  NOTE  LH-;  2  )-=  0 . 693 1  47  .  ) 

TUR03770 

HPuW=IFIX<  ALOGC  FLOAT<  NH  .)  VO  .  693147  ) 

TUR 03780 

NMA,Y=2**NP0W 

TUR03790 

IF  <MM.EQ.NMAX)  GO  TO  1900 

TUR 076 00 

C  IF  MM  IS  NOT  A  POWER  OF  2  THEN  RESET  THE  REST  OF  ARRAY  RAN 

TUR0361 0 

NPOW=NPOW+1 

TiJR03&<:0 

ISTART=MM+1 

TUR03&30 

NrlAX=2t»*NP0W 

TUR 03640 

DO  1800  I=ISTART,NMAX 

TUR  0365  0 

RAN< I  )=<  0. 0, 0. 0) 

TUR 03860 

1800  CONTINUE 

TUR03870 

C  COMPUTE  AND  WRITE  MEAN  AND  VARIANCE  OF  RANDOM  ARRAY 

TUR03S80 

1900  WRITE  <IOOUT,530O> 

TUR03&90 

CALL  MEANVR<1,M) 

TUR03900 

C  FAST  FOURIER  TRANSFORM  RANDOM  ARRAY 

TUR 0391 0 

C  CDC  ROUTINE  CALL 

TUR03920 

C  CALL  FFT<RAN,MM,-»-l  > 

TUR 03930 

CALL  FFT4< 1 . 0,RAN,NPOW,NMAX) 

TUR03940 

DO  2100  1=1, MM 

TURC3950 

RAN< I )=RAN< I  )/MSQ 

TUR 03 960 

2100  CONTINUE 

TUR  0397  0 

C  COMPUTE  AND  WRITE  MEAN  AND  VARIANCE  OF  TIME  SEQUENCE. 

TUR 03980 

WRITE  < IOOUT,5500) 

TUR 03990 

CALL  MEANVRCMI ,Mn) 

TUR 04 000 

C  WRITE  TRANSFORMED  ARRAY  VALUES  CORRESPONDING  TO  TIME  VALUES 

TUR0401 0 

C  OF  POINTING  JITTER  FOR  ONE  DIRECTION. 

TUR  0-4  050 

IF  <NPRINT.E0-2,0R,NPRINT,EQ.3)  WRITE  <IOOUT,5400)  DELT 

TUR 04 030 

DTIME=DELT 

TUR 04 040 

TINC=DELT>H0.0 

TUR 04 050 

IF  <NPRINT.EQ.2.0R.NPRINT.Ea.3)  WRITE  <100UT,5700> 

TLIR04Oe.O 

IF  <NPRINT .EQ.2.0R.NPRINT.EQ.3)  WRITE  <IOOUT,5800)  POCHAR 

TUR 04 070 

DO  2300  I1=M1 ,MM, 1 0 

TUR040S0 

DO  2200  I2=( , 1 0 

TUR04090 

13=11+12-1 

TUR(I41  00 

RR< 12 >=REAL< RAN< 13)) 

TUR 041  1  0 

2200  CONTINUE 

TUR04120 

1F<NPRINT.EQ.2.0R.NPRINT.EQ.3)URITE< IOOUT,2800>DTIME, 

TUR 04 130 

1  ':rr<  I ),  1=1 , 1 0) 

TUR041 40 

DT1ME=DTIME+TINC 

TUR04150 

2300  CONTINUE 

TUR 041 60 

2400  CONTINUE 

TUR041 70 

C 

TUR 04  ISO 

C 

TUR04190 

2500  FORMAT  < 1 X, 1 0 0< 1 H* ), /,  1 3H  WAVELENGTH  <,F10.3,7H>  GREAT, 

TURC4200 

40 

1 

1 

2700  FORMAT 
2800  FORMAT 

3000  FORMAT 

3001  FORMAT< 

1  IX, A4, 
3100  FORMAT 

1 

3200‘^FORMAT 
3300  FORMAT 
1 

2 
3 

3400  FORMAT 


3500  FORMAT 
1 

3600  FORMAT 
1 

3700  FORMAT 
1 

3800  FORMAT 
3300  FORMAT 
1 

2 

4000  FORMAT 
1 

2 

4100  FORMAT 
1 

2 

4200  FORMAT 
1 

2 

4300  FORMAT 
4400  FORMAT 
1 

4500  FORMAT 
1 

2 

3 

4550  FORMAT 
4600  FORMAT 
1 
2 

3 

4 

5 

6 

7 

8 
9 

4700  FORMAT 
1 

4800  FORMAT 
4900  FORMAT 
1 

5000  FORMAT 
1 

5100  FORMAT 
5200  FORMAT 
5300  FORMAT 
1 

5400  FORMAT 
1 

5500  FORMAT 


40HER  THAN  14  MICRONS:  CONTROL  RETURNED  TO 
21HMAIN  FROM  TURBULENCE ..Z, 1 X , 1 0 0< 1 H*  )  > 
<5F16.6) 

<E10,4, 10E12.4) 

<A4,6X,7E1 0.4; 


TUP '■  421  0 
TUft  0-122  C 
TUR0423C 
TUR 04240 
TUR0425C 


1H0,20X, 45HTHE  FOLLOWING  ID-FIELD  NOT  RECOGNIZED  BY  TURB , / , TUR 0426 C 
6X,7E10.4;  TUR04270 

<1H1,36H  CALCULATION  OF  POWER  SPECTRUM  AND  TUR04280 

1 1HTURBULENCE  29HIHDUCED  POINTING  JITTER  OF  A  TUR04290 

23HLASER  TARGET  DESIGNATOR;  TUR043(iC 

< 1H+, 1 01X, 1 uHAND  SEEKER;  TUP043iu 

<  1H0/41X,30HLASER  WAVELENGTH  <  MICROMETERS  8X ,  TL'R04720 

FI  0.4,2/’,42X,26HOESIG.  APERTURE  DIAMETER  <  TUR04330 

7HMETERS;,5X,F1  0.6,/'/',42X,  18HBEAMSPREAD  ANGLE  <  TUR  0434  0 

8HRADIANS), 12X,F1 0.6)  TUR043C0 

< 1H0,41X,33HSEEKER  APERTURE  DIAMETER  <METERS),5X,  7UR04360 

FI  0.6,2/, 42X,36HRANGE  FROM  TARGET  TO  SEEKER  <METERS),  TUR04370 

2X,F10.2)  TUR04380 

< 1H0,41X,24HBEAM  SLUE  RATE  < RAO/SEC  ), 1 4X , F 1 0 . 6 ,  TUR04390 

//, 42X, 26HDESIGNATI0N  RANGE  < METERS  ), 1 2X ,  TUR04400 

F10.2)  TUR04410 

< 1HO,41X,26HDURATION  OF  TEST  < SECONDS  ), 1 2X ,  TUR04420 

F10.4)  TUR04430 

<  1H0,41X,30HTOTAL  DESIGNATOR  PATH  SEGMENTS ,  1  5X ,  TURCi4440 

13)  TUR04450 

<  1H0,41X,26HT0TAL  SEEKER  PATH  SEGMENTS ,  1  9X ,  1 3  )  TURC44fc.Ci 

<  1HO,41X,27HTOTAL  FREQUENCIES  FOR  WH 1 CH , ,  42X ,  TUR04470 

22H  POWER  SPECTRUM  IS  T0,/,42X,  TUR04480 

15H  BE  CALCULATED,  27X,  14)  TUROII-iO 

<  1H0,///,26X,29H  VALUES  OF  REFRACTIVE  INDEX  TUR0<i500 

37HSTRUCTURE  CONSTANT  AND  WIND  SPEED  IN  TUR04510 

15H0ESIGNAT0R  PATH)  TUR0452i:i 

< 1H0,///,26X,29H  VALUES  OF  REFRACTIVE  INDEX  TUR04530 

37HSTRUCTURE  CONSTANT  AND  WIND  SPEED  IN  TUR04540 

1 1HSEEKER  PATH)  TURD455u 

<  1H0,62X,5HC.N*>«2,9X,9HW1HDSPEED,  16X,/,42X,  TUR  0456  0 

11HSEGMENT  NO  ,  ,  5X ,  1 5H<  METER*>*< -2/3  )  >,  3X,  TUR04570 

1 1H< METER/SEC),//)  TUR0458P 

<1H  ,46X. 12, 1 0X,E12.6,5X,F1 0.2)  TUR04530 

<1H0,//,36H  THE  VARIANCE  OF  THE  POWER  SPECTRUM  TUR04600 

3HIS  ,E12.4)  TUR0461 0 

< 1H1 , //,56X,20HDESIGNATOR  TO  TARGET ,//, 38X ,  TUR04620 

//,24X,41HV1RTUAL  POINT  SOURCE  TO  APERTURE  DISTANCE,  TUR04630 

28X,F10.5,9H  < METERS  ),//, 24X, 22HD I  STANCE  FROM  VIRTUAL  TUR04640 

22HP0INT  SOURCE  TO  TARGET, 25X, FI  0 , 5, 9H  CMETERS))  TUR04650 

<  INI  , //,S8X,  16HTARGET  TO  SEEKER,//)  "''IR04660 

<  1H0,23X,27HIHTEGRATED  COHERENCE  LENGTH ,  42X,  F 1  0 . 6 ,  TU.-.04670 

9H  < METERS  ),//,24X,36HDIAMETER/INTEGRATED  COHERENCE  LENGTHTUR 04  68 0 
,33X,F1 0.6,//,24X,31HTRANSMlTTER-INDUCED  BEAM  SPREAD  TUR04690 

13X,E12.5,  1  OH  (RADIANS), 3X,F10. 6, 9H  (METERS),  TIJR04700 

//,24X,31HDIFFRACTI0N-LIMITE0  BEAM  SPREAD , 1 3X , E 1 2 , 5 ,  TUR0471 0 

10H  (RADIANS), 3X,F10. 6, 9H  ( METERS  ),//, 24X ,  TUR04720 

38HDIFFRACTI0N  AND  TURBULENCE  BEAM  SPREAD , 6X , E 1 2 . 5,  TUR04730 

10H  (RADIANS), 3X,F10. 6, 9H  ( METERS  ),///, 24X , 6HT0TAL  TUR04740 

19HEFFECTIVE  BEAM  S 1 2E , 1 9X , El  2 . 5, 1  OH  ( RADI ANS  ) , 3X , F 1 0 . 6 ,  TUR04750 

9H  (METERS),//)  TUR 04 760 

( 1H0,34X, 1 1HSEGMENT  NO . , 9X, 1 6HC0HERENCE  LENGTH,  TUR04770 

5X,27H  REFERENCE  FREQUEHCY( HERTZ  ),// )  TUR 0473  0 

(1H  ,38X, 12, 1 0X,F16 .6, 1 0X,F16.6)  TUR 04790 

(1H0,19H  RMS  SPOT  JITTER  =  ,E10.4,10H  RAD,  OR  =  TUR04800 

, E10. 4, 7H  METERS,/)  TUR04810 

( 1H1 , 1X,40X,31H  CALCULATED  POWER  SPECTRUM  VS.  TUR04820 

9HFREQUENCY,/,47X, 16H  AT  INTERVALS  0F,F6,3,6H  HERTZ)  TUR04S30 

(1H0,37H  OUTPUT  FOR  DESIGNATOR  TO  TARGET  PATH)  TUR04840 

(1H0,33H  OUTPUT  FOR  TARGET  TO  SEEKER  PATH)  TUR04850 

(1H0,35X,35H  MEAN  AND  VARIANCE  OF  RANDOM  ARRAY  TUR04860 

,//)  TUR04870 

( 1H1 ,49X,34HVALUES  OF  POINTING  JITTER  VS,  TIME  /  TUR04880 

52X,16H  AT  INTERVALS  0F,F8,4,4H  SEC)  TUR04890 

( 1H0,//,35X,28H  MEAN  AND  VARIANCE  OF  TIME  TUR04900 
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i  dHSEQUENCEX/^  >  TUR04 

5600  FORMAT  <1H  . 1  OH  BEGINNING, 1  OH  FREQ  < HZ > >  TUR04 

5700  FORMAT  < 1H  ,2X,5H  TIME,/,2X,6H  <SEC>>  TUR04 

5800  FORMAT  < 1 H+ , T 1 3 , 46< 1 H- ^ , t H  , 4A4 , 55< 1 H- >, / >  TUR04 

RETURN  TUR04 

END  TUR04 
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'X'  •£>  '-D  ’X*  'X* 


M 


FUNCTION  i>ESUB<  X,DRO  j 
C  FUNCTION  USED  FOR  INTEGERATION  F< X ) 

FACTR=3.44*<[>R0*X>>»*1 .666667*<  1  . -X>»*0 . 333333  > 

IF<FhCTR.LT, t60.  >  GO  TO  10 

0ESUB=0. 

GO  TO  20 

10  ARCCX=hTAN2<l  SQRT<  1  . X  ) 

DESLIB=X*<  <  ARCCX-X*<  1  .  -X*»2  J*-*  ,  5  >*EXP<  -FACTR  >  > 
20  RETURN 
END 


DESOOOi 0 
DES00020 
DES1J0  03  0 
DES00040 
DES00050 
DES00060 
DES00070 
DES00080 
DES00090 
DES001 00 


i  00 

200 

300 

400 

50  0 

fcOO 

700 

800 

900 


FUNCTION  F8LPH<XI1 > 

IF  <XI1 ,GE. .5623)  GO  TO  100 
FALPH=1  0 .66‘*<:  <  X1 1  )**2  ) 

GO  TO  900 

IF  <XI1 .GE. t  . 0)  GO  TO  200 
F8LPH=4. 025*XI 1-. 00659 
GO  lO  900 

IF  <XIi .GE. 1 .778)  GO  TO  300 
FhLPHsI  .  8547t‘X1 1+2.164 
GO  TO  900 

IF  <XI1 .GE.3. 162)  GO  TO  400 
FALPH= ,8475*XI 1+3 ,955 
GO  TO  900 

IF  <XI1 .GE.5.623)  GO  TO  500 
FhLPH=.391+XI1+5.3977 
GO  TO  900 

IF  <XI1  .GE. 1 0.  )  GO  TO  6u0 
FALPH=. 1 81 4+X I  1+6,578 
GO  TO  900 


IF 

<XI1 

.GT.31 .62) 

GO 

TO 

700 

FALPH= , 

0534+XI1+7 

,95 

GO 

TO  90  0 

IF 

<  Xi  1 

.  GT  .  1  000  .  ■) 

GO 

TO 

800 

ir  \AiiiUi4iuvv./ 

FALPH=7.8*<XI1+*.06> 


GO  TO  900 
FALPH=1 1 .97 
RETURN 
END 


FhLOOi.1  '  0 
FALOOOiO 
FhLOOO 
FPL  0004  0 
FhLOOOsO 
FAL0006C 
FhLOOOi'O 
FAL0('08  0 
FhLoC09u 
FALOOl 00 
FpLOOI i 0 
FPL00120 
FhlODI jO 
FAL00140 
FttLOCliSO 
FpLOOI 60 
FAL001  I'O 
FAL 0  0  I  SO 
FALOOi 90 
FAL  0  02  0  0 
FPL0021 0 
FPL00220 
FpL002j0 
FpL 00240 
FpL00230 
FAL 00260 
FAL00270 
FAL00280 
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SUBROUTINE  FFT4<  SIGN,  X,  NPOW,  HHM  > 

COOLEV-TUKEY  METHOD  OF  FOURIER  TRANSFORM 

INCLUDES  SINE  COSINE  COMPUTATION  AND 

REARRANGING  DATA  ACCORDING  TO  REVERSE  BIT  ADDRESSES 

SIGH  =  FOURIER  DIRECTION  TRANSFORM  FLAG 

-1 .  FOR  DIRECT  TRANSFORM,  TO  COEFFICIENTS  FROM  SERIES 
t .  FOR  INVERSE  TRANSFORM,  TO  SERIES  FROM  COEFFICIENTS 

X  =  LOC.  OF  FOURIER  TRANSFORM  BLOCK 

NPOW  -  POWER  OF  2  TO  OBTAIN  NMAX 

HMAX  =  LENGTH  OF  BLOCK  X 

COMPLEX  X, exes, HOLD, XA 
DIMENSION  CS<2),MSK< 13) 

DIMENSION  X< 1 ) 

EQUIVALENCE  <.CXCS,CS> 

ZZ=6 . 283 1  853  OS'fS  I  GH/’FLOAT<  NMAX  ) 

MSK<  1  )=NMAX/'2 

DO  100  1=2, NPOW 

MSK< 1 )=MSK<  1-1  i/2 

CONTINUE 

NN=HMAX 

MM=2 

LOOP  OVER  NPOW  LAYERS 
DO  800  LAYER=l,NPOW 
NN=HH,-'2 
NW=0 

DO  700  1=1, MM, 2 
II=HN-»I 

exes  =  CEXP<2*PI*NW*SICN/'NMAX> 

U=FLuAT<  NW )*22 
CS<  1  )»COS<W) 

CS<  2 )«8IN<  W  > 

COMPUTE  ELEMENTS  FOR  BOTH  HALFS  OF  EACH  BLOCK 
Du  200  J=1 ,NN 
II*=II  +  1 
I J=II-NN 
XA=CXCS*X<  II > 

X< II )=X< IJ)-XA 
X< IJ)=X< I J)+XA 
CONTINUE 

BUMP  UP  SERIES  BY  2 
COMPUTE  REVERSE  ADDRESS 
DO  400  L0C-2,NP0W 
LL-NW-MSK<LOC) 

IF  <LL)  500,600,300 

NW=LL 

CONTINUE 

NW=MSK<LOC)+NU 

GO  TO  700 

NU=MSK<LOC  +  1  ) 

CONTINUE 

MM=MMk2 

CONTINUE 

DO  FINAL  REARRANGEMENT 
NW=0 

DO  1600  1-1, NMAX 
NWl-NW+l 
MOLD-X<NU1 ) 

IF  <NW1-I )  1 1 00, 1 000,900 
X<NW1>-X<1) 

X< I >-HOLD 

BUMP  UP  SERIES  BY  1 
COMPUTE  REVERSE  ADDRESS 
DO  1300  LOC-1 ,NPOW 
LL»NW-MSK<LOC> 


FFT”u01 0 

FFTO0020 

FFT00030 

FFT00040 

FFT00050 

FFT00060 

FFTOOOi'U 

FFT00080 

FFT00090 

FFTOOl 00 

FFTuOl 1 0 

FFT00120 

FFT  001 3  0 

FFT  0  0 140 

FFT  0  0150 

FFT  0  0 160 

FFTOOl 70 

FFT00180 

FFT00190 

FFT 002 00 

FFT0021 0 

FFT00220 

FFT002jC' 

FFT00240 

FFT00250 

FFT00260 

Ft- TO  02  rO 

FFT 00280 

FFT 00290 

FFT00300 

FFT0031 0 

FFT00320 

FFT00330 

FFT 00340 

FFT 00350 

FFT 00360 

FFT00370 

FFT 00380 

FFT00590 

FFT00400 

FFT0041 0 

FFT00420 

FFT00430 

FFT00440 

FFT00450 

r‘^T00460 

FF I  0  047  0 

FFT 00480 

FFT00490 

FFT00500 

FFT0051 0 

FFT00520 

FFT 00530 

FFT 00540 

FFT00550 

FFT 00560 

FFT00570 

FFT00580 

FFT00590 

FFT 006 00 

FFT  0061  0 

FFT0C620 

FFT  00630 

FFT00640 

FFT00650 

FFT 00660 

FFT00670 

FFT00680 

FFT00690 

FFT00700 
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IF  <LL)  1400. 1500. 1200 

FFTOOV ' 0 

1200 

NU=LL 

FFTOO?;^ 

1300 

CONTINUE 

FFTOOT,  o 

140  0 

Nu/=r1SK<LOC  >+NW 

FFT00740 

CO  TO  1600 

FFT0u750 

1500 

NW=MSK<LOC  +  1  > 

FFT 00760 

1600 

CONTINUE 

FFT0  077  i’ 

IF  <SIGN>  1900. 1900. 1700 

FFT  0  0780 

1700 

PTS=>NMAX 

FFT00790 

DO  1300  I»1.NMAX 

FFT  0  08  00 

X<  I  j=X<  I  )/'PTS 

FFT0031 0 

180  0 

CONTINUE 

FFT00820 

1900 

RETURN 

FFT  00830 

END 

FFT00S40 

oon 


FUNCTION  GftU3S<N,XBrtft,SIGHH> 

GENERATE  RANDOM  NUMBERS  UlTH  NORMAL  DISTRIBUTION 
MEAN  =  XBAR 

STANDARD  DEVIATION  >  SIGMA 
DATA  NN  /O/ 

IF  <NN.GT.0>  GO  TO  1 
NN=1 
C»0. 

1  CONTINUE 

X»0. 0 

IF  (C.EG.O.O)  C-735, 34823 
DO  100  J=1,N 
C*RAHD<C  ) 

X*X+C 

1 00  CONTINUE 
XN=N 

X-SQRT<  1  2  .  O/'XN  >f  <  X-0 . 5*XN  > 

GAUSSbSIGHA*X-^XBAR 

RETURN 

END 


GAUi'001  0 
GAU00030 
GAU 00040 
GAU00050 
GA000080 
GAU00070 
GAU 00 080 
GAU 00 090 
GAU001 00 
GAU001 1 0 
GAU00120 
GAUOOt  30 
GAU00140 
GAU00150 
GAU001 60 
GAU00170 
GAUOOl 30 
GAU00190 
GAU00200 
GAU 0021 0 
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SUBROUTINE  MEANVR< N1 , N2 > 

COMPUTE  AND  URITE  MEAN  AND  VARIANCE  OF  COMPLEX  ARRAV 
OVER  SOME  RANGE  OF  THE  ARRAY. 

++  INPUT  ++ 

N1  =  STARTING  INDEX  OF  RANGE 
N2  =  ENDING  INDEX  OF  RANGE 
++  COMMON  ++ 

RAN  =  COMPLEX  ARRAY  CONTAINING  DATA 
++  OUTPUT  ++ 

MEAN1  =  MEAN  OF  REAL  PART 


MEAN2 


MEAN  OF  IMAGINARY  PART 


VAR1  «  VARIANCE  OF  REAL  PART 

VAR2  *  VARIANCE  OF  IMAGINARY  PART 

COMPLEX  RAN 
REAL  MEAN1,MEAN2 

THIS  IS  A  COMPLEX  NUMBER  EACH  HUMBER  TAKES  TUO  WORDS 
COMMON  /'MO5/'RAN<2  04S> 

COMMON  XIOUNIT/IOIN, lOOUT, IPHFUN,LOUHIT,NDIRTU,NCLIMT,KSTOR, 
MEAN1=0. 

MEAN2=0, 

VARl-0, 

VAR2=0, 

DO  too  I*N1,N2 
MEAN1=REAL<RAN< I >)+MEAN1 
MEAN2«AIMAG<  RAN<  I  >  )-(-MEAN2 
VARI=><REAL<RAN<  I  >  >  •)>»>*2+VAR  f 
VAR2=<AIMAG<RAN<  I  J  )*>«2+VAR2 
too  CONTINUE 

MEAN1=MEAN1/'FL0AT<N2-N1  ) 

MEAN2=MEAN2/FL0AT<N2-N1 > 

VARf =VAR1/FL0AT<N2-N1  ) 

VAR2=VAR2^FL0AT<N2-N1 > 

WRITE  <IOOUT,200>  MEAN1,MEAN2 
URITE  <IOOUT,300)  VAR1,VAR2 
RETURN 

200  FORMAT  <35X,20H  MEAN  OF  REAL  PART  =,E12.5,10H,  MEAN  OF 
t  1  IHIMAG  PART  =',E12.5> 

300  FORMAT  <35X,20H  VAR.  OF  REAL  PART  =,E12.5,t0H,  VAR.  OF 
1  1 IHIMAG  PART  =,E12.5) 

END 


MEAOeoi  i' 
MEAOOO;?'-' 
MEAOOOo. 
MEAODC-m 
MEAC005C 
MEA0006L 
MEAO jO?. 
MEAOOOat 
MEAOOOSO 
MEA001 00 
MEAOOi i 0 
MEA001 20 
MEAOOi 30 
MEACOMO 
MEAOCtSO 
MEAOOi 60 
MEA00170 
MEA001S0 
MEAOOI 90 
MEA00200 
MEA0021 0 
MEA 00220 
MEA00230 
MEA 00240 
MEA 00250 
MEA 00260 
MEA 00270 
MEAC0280 
MEAO  029  0 
NPLOTUMEA00300 
MEA003*  0 
MEA 00320 
MEA  0  0331. 
MEA00340 
MEA00350 
MEA 00360 
MEA00370 
MEA00380 
MEA00390 
MEA 004 00 
MEA 0  04  I  0 
MEA 00420 
MEA 00430 
MEA00440 
MEA00450 
MEAC0460 
MEAO  "47  0 
MEA 0  0  7  3  0 
MEA 00490 
MEA00500 
MEA 0051 0 
MEAOOSEO 
MEA00530 
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SUBROUTINE  SPECT< F, D2, N, F 1 , LAMB > 

THIS  ROUTINE  GENERATES  THE  APPROXIMATE  FUNCTION 
G<ALPHA>  <F,^F<3UB  0,l>i 

USED  IN  THE  POWER  SPECTRUM  OF  ANGLE-OF-ARRI VAL  EQUATION 
REAL  LAMB 

COMMON  /'M01/'FR<  1  025  ) .  CH<  20  ),  V1<  20  >.  FO<  20  >.  RO<  20  ) 
FACT=1 .32E-2>*<LAMB/D2)*>»2 
F1  =  0, 

DO  100  I«1,N 

IF  < F . LE . . 332*F0< I ) )  G-1 . 

IF  <F.GT.  .332*F0<  I  ))  G=  i  .  1 2- .  361  ■*‘F/’FO<  I  > 

IF  <F.GE.3. 1  0-*FO<  I  )>  G=0. 

FI  “FI  +FAuT ♦<  <  D2<^R0<  I  >  F‘t'F'«FO<  I  )  >  .  33333*G 

100  CONTINUE 
RETURN 
END 


SPE0001 0 
SPE00020 
SPE:0030 
SPE00040 
SPE00050 
SPE00060 
SPE00070 
SPE00080 
SPEuOOSO 
SPE001 00 
SPE001 1 0 
SPE001 20 
5PE00130 
SPE00140 
SPEuOl 50 
SPEOOl 60 
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SUBROUTINE  3PREAD< DIRM, ROT, WRVE, THET , RANG, DRO, THETDL , DDL , THET 1 2 , 
1  D12,DTHET,DT0T> 

COMPUTATION  OF  BEAM  SPREAD  ANGLE  DUE  TO  DIFFRACTION  AND  DIFFRACTION 
AND  TURBULENCE  AND  SPOT  DIAMETER  ON  TARGET  < OR  SEEKER). 

DRO=DIAM,-’ROT 
C  DO  \/2  SIMPSON  RULE  INTEGRATION 
'/ARS<;=0 . 0 
DELTAX=0. 01 

RDRO=DESUB(  VARX,  DRO  )/’2 . 0 
DO  100  1=1,100 
VARX=VARX+DELTAX 
RDRO=RDRO+DESUB<  VARX, DRO  > 

100  CONTINUE 

RDftO=<  RDRO-DESUB<:  VARX,  DRO  >/2 . 0  i^^DELTAX 
RDRO  =  t  .  OXt  SQRT<  5 . 092958>*<  DRO  RDRO  )  ) 

THETDL=1  .  iSS-t-WAVEXDIAM 

DDL=THETDL>t‘RANG 

THET 1  2=THETDL*DRO>*ROPO 

D  1  2=THET  1  2"vRANG 

DTHET=SQRT<  THET1  2’*>*2+THETt<>»2  ) 

DTOT=DIAM+DTHET=«RANG 

RETURN 

END 


3PR0001 0 
SPR0002C 
SPR0003C 
SPR0  00‘t0 
SPR00050 
SPROOOoO 
SPRuOr?'' 
SPROuijSO 
3PR  u  0  09  0 
SPR001 00 
SPR001 1 0 
SPR00120 
SPR00130 
SPROOMO 
SPR00150 
SPR  0  0  ISO 
SPROCn  70 
SPR001 SO 
SPRuOl 90 
SPR 002 00 
SPR0021 0 
SPR00220 
SPR 00230 
SPR 00240 
SPR00250 
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SUBROUT  I NE  THETO<  THETAO ,  F<^LPH ,  CN2 ,  D 1 V ,  R I  V ,  N2  > 

++  CALLED  FUNCTIONS  ++ 

RALPH 

DIMENSION  CN2<20) 

COMMON  /^lOUNlT/IOIN, lOOUT, IPHFUN,L0UN1T, NDIRTU, NCLIMT, 
DELI  V=»R1  V/FL0AT<N2) 

CALCULATE  D1IHF 
D1  INF=0. 

S1-DELiV/'2. 

S=0. 

D 1  V3=<  01 V  >♦<:-.  3333) 

DO  100  1=1, N2 
S=S+S1 

D1  INF=DEL1  V*CN2<  I  >*<<  S/^R1  V  >■*■*!  .6667)+D1  INF 
SI =DEL 1 V 
1 00  CONTINUE 

D1 INF=0.5*1 1 .97fD1V3*D1 INF 
INITIAL  ESTIMATE  FOR  THETAO 
WRITE  <IOOUT,500)  D1INF 
THETAO=1 ,E-4 
200  XI1=0. 

DITHE=0, 

S=0 . 

S1-DEL1V/’2. 

DO  300  1=1 ,N2 
S=S+S1 

X 1 1  =THETAO*<  R 1 V-S  VD 1 V 

D 1  THE=DEL  1  VhiCN2<  I  )*<  <  SXR 1  V  >♦♦  1  . 6667  >*FALPH<  X II  >+D  1  THE 
S1=DEL1V 
300  CONTINUE 

D1THE=D1THE>*01V3 

IF  <ABS<<D1INF-D1THE>XD1INF>.LT. .001 >  CO  TO  400 
THETAO=THETAO#< 1 .  +  . 5*<  D1 INF-D1 THE  VDl IHF  > 

WRITE  <IOOUT,500>  THETAO, 01THE 
GO  TO  200 
400  CONTINUE 

WRITE  <IOOUT,500>  D1THE 
RETURN 

500  FORMAT  <2E16.8) 

END 


THE0001 0 
THF00020 
THt00030 
THE00040 
KSTOR,NPLOTUTHE00050 
THE00060 
THE00u70 
THE 00 080 
THE00090 
THE001 00 
THE001 1 0 
THE00120 
THE00130 
THE00140 
THh0ui5u 
THE  0  0 1 6  0 
THE001 70 
THE001 80 
THEOOiSO 
THE00200 
THE0021 0 
THE00220 
THE002.50 
THE 00240 
THE00250 
THE00260 
THE00270 
THE 00280 
THE 00290 
THE00300 
THEOOjI 0 
THE00320 
THE00330 
THE00340 
THE00350 
THE00360 
THE00370 
THE00380 
THE00390 
THE00400 
THE0041 0 


I 


000000000000000000000000000000000000000000000000000000000000000000000 


SUBROUTINE  BASCAT< UrtVE , EXCO, lERR) 

ssss***s***ss***s*s%*s*s*s****s***s****s*s**s***tt**^sts**s******ss* 

THIS  VERSION  OF  BASCAT  <20  SEP  81)  DIFFERS  FROM  THE  EOSAEL  80 
VERSION  IN  ITS  INTERNAL  PROGRAM  STRUCTURE  AND  OUTPUT  CAPABILITV, 
INPUT  FORMATTING  HAS  NOT  BEEN  CHANGED.  BRIEFLY,  THE  INTERNAL 
STRUCTURAL  CHANGES  CONSIST  OF  THE  FOLLOWING  : 

<  A) 


BASOO 
EASC  "1 
BASt  j 
BAS  ?  0 
BAi.  C  -'i 
BAS  .  ' 
BA 

SAb  '■ 
BAS  li 


.1  0  ?  L 

'  I.'  S  c 
0 


<B : 

<  c : 

<D) 

<  E  ) 


<F) 
<  G  > 


SUBROUTINE  THIT  HAS  BEEN  ELIMINATED.  THE  FUNCTIOHS  WHICH 
IT  ONCE  PERFORMED  HAVE  BEEN  CONSOLIDATED  INTO  SUBROUTINE  SASOjIOO 

START .  SaSOO  :  <  0 

A  NEW  LIDAR  BIASING  ALGORITHM  HAS  BEEN  INSERTED.  BASCOiBO 

DIRECT  BEAM  <I.E.,  UHSCATTERED)  COMPUTATIONS  IN  BASOOISA 

SUBROUTINE  START  HAVE  BEEN  REVISED.  eAS0014C 

SUBROUTINE  COHV  HAS  BEEN  MODIFIED  SO  THAT  THE  DIFFER-  BASOinSC 

ENCE  OF  TWO  NUMBERS  RETAINS  MORE  SIGNIFICANT  DIGITS.  BASOOiSO 

NUMERICAL  CHECKS  FOR  IMPROPER  ARGUMENTS  OF  FUNCTIONS  BaS00170 

<DIVISIOHS,  SQUARE  ROOTS,  LOGARITHMS,  ETC.)  HAVE  BEEN  BASuOISO 

REVISED.  BAS00190 

ARGUMENT  LISTS  OF  A  FEW  COMMON  BLOCKS  HAVE  BEEN  CHANGED.  BAS u 02 00 

WRITE  STATEMENTS  FOR  OUTPUTTING  BASCAT  RESULTS  TO  A  UStR-  BAS00210 
DEFINED  PLOT  FILE  <NPLOTU)  HAVE  BEEN  INCLUDED.  THESE  STATE-  BAS0C220 
MENT3  MUST  BE  UNCOMMENTED  IN  ORDER  TO  ACTIVATE  THEM.  BAS00230 

*it*itttt*tt*t**t***********t***t***t********iti**tt*****tttt**tstttft*Z<(^^K.<ui4  0 

BAS00250 

THE  BASCAT  MODULE  ALOHE  USES  THE  FOLLOWING  SUBROUTINES! 

BKWD  -  CONTAINS  BACKWARD  SCATTERING  ALGORITHM 
CONV  -  CONVOLVES  IMPULSE  RESPONSE  WITH  SQUARE  PULSE 
ELM  -  DETERMINES  BIASING  DISTANCES 

FIND  -  DETERMINES  INTERPOLATED  PHASE  FUNCTION  VALUE 
FWRD  -  FIRST  ORDER  SCATTERING  ALGORITHM 

GAS  -  DETERMINES  MONTE  CARLO  SCATTERING  ANGLES  FOR  TRAVERSES 
GMAX  -  DETERMINES  MAXIMUM  OF  AN  INPUT  ARRAY 
MATRX  -  GENERATES  ROTATION  MATRICES 

ROTAT  -  ROTATES  VECTORS  FROM  ONE  COORDINATE  SYSTEM  TO  ANOTHER 
SMOOZ  -  DETERMINES  START  OF  TRAILING  ZEROS  IN  INPUT  ARRAY 
START  -  INITIATES  PHOTON  TRA..IECTORIES 

TRAVRS  -  MOVES  PHOTONS  BETWEEN  SCATTERING  POINTS  AND  FINDS  OB¬ 
SERVED  POWER  CONTRIBUTIONS  AT  THOSE  POINTS 
USCA  -  SELECTS  RANDOM  ANGLES  WEIGHTED  BY  PHASE  FUNCTION 


TWO  SUBROUTINES  SHARED  BY  BASCAT  WITH  OTHER  EOSAEL  80  MODULES 
ARE  THE  FOLLOWING  ! 

PFUHC  -  SELECTS  AND  RENORMALIZES  PHASE  FUNCTION  DATA  FROM 
EOSAEL  80  DATA  BASE 

RAND  -  RANDOM  NUMBER  GENERATOR  < GENERATES  UNIFORM  DISTRIBUTION 
OF  RANDOM  NUMBERS  BETWEEN  0  AND  1  ) 

**  NOTE**  THE  FOLLOWING  ROUTINES  UTILIZE  THE  RANDOM  NUMBER  GENERATOR 
WHICH  IS  INVOKED  HS  FUNCTION  'RAND<SEED>  ; 

<A)  BKWD  -  3  OCCURRENCES  OF  FUNCTION  RAND 

<B^  FWRD  -  2  OCCURRENCES 

<C)  GAS  -  3  OCCURRENCES 

<D)  START  -  2  OCCURRENCES 

<E)  TRAVRS  -  2  OCCURRENCES 

USERS  OF  OTHER  < NON-HP)  COMPUTER  SYSTEMS  MUST  REPLACE 
FUNCTION  RANDCSEED)  WITH  A  UNIFORM  RANDOM  NUMBER  GENERATOR 
WHICH  WORKS  FOR  THEIR  SYSTEMS.  THE  RANDOM  NUMBER  SEED  IS 
INITIALIZED  IN  SUBROUTINE  BASCAT.  THIS  AND  ALL  SUBSEQUENT 
VALUES  OF  THE  RANDOM  NUMBER  SEED  ARE  PASSED  VIA  COMMON 
BLOCK  -RNDM'.  SHOULD  THE  RANDOM  NUMBER  SEED  USED  HERE 
<735.34829)  BE  INAPPROPRIATE  FOR  THE  USER'S  SYSTEM,  IT  IS 
SUGGESTED  THAT  THE  INITIALIZATION  USED  BELOW  <SEEDO= 
735.34829)  BE  CHANGED  TO  AN  APPROPRIATE  VALUE. 

SUBSTANTIAL  MODIFICATIONS  HAVE  BEEN  MADE  TO  THE  FOLLOWING 
SUBROUTINES  PRESENT  IN  EOSAEL  80  ; 

CONV 


BAS002bu 
BAb 00240 
BASC  028  0 
BAS 0  j29  0 
BAS  0  03 0  0 
BASOOo' 0 
BhS  0  Oi7.2 
BASOOS'3. 
BAS  0  074  0 
BAS005SO 
BASOObSO 
BAS  0  037  0 
BAS 00380 
BAS00380 
BAS  0  04  0  0 
BAS004 i 0 
BAS  0  042  0 
"1  AS  0  0430 
l;.  )S  0  0440 
BAS 00450 
eAS0’)46  0 
BAS'.  '47  0 
BAS  O  b  .2 '.I 
BAS 0  04:  (■; 
BASuOSjO 
BAS  0  051  0 
BAS  0  052  0 
BAS 00530 
BAS 00540 
BAS  0  055  0 
BAS  0  056  0 
BAS00570 
8AS00580 
BAS00590 
BASOOeOO 
BAS  0  06 1 0 
BAS00620 
BAS 006 30 
BAS0064  0 
BASOO''''--,  j 
BAS00660 
BAS00670 
BAS 00680 
BAS00650 
BAS 04? 00 
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TkhVkS  bHiil 

START  8AS'' 

BASi 

COMMuN.'‘RNDM^SEED  BASi 

COMMON  /GEOMET/PTS< 15), IGEOSU  BAS( 

C0MM0N/ALL/AT,BT,CT,BL1M  BAS( 

COMMON/IOUNIT/'IOIN, lOOUT, IPHFUH , LOUN IT, ND IRTU , NCL 1 MT , KSTOR , NPLOTU  BAS( 
COMMON  /'C0NST^PI,PI2.PIRAD,TU0PI,T0RRMB,CDEGK  BAS( 

COMMON  /M05/V1 ,C1 ,S1 ,SA<  3),EN<  10,1 0  0>,ENC^ 1 0  ) , ELM  I N , DELD , DTOT ,  BAS( 
+NTMAX,NSCAM,KMAX,LMAX,LMM1  BAS( 

COMMON  /BASP0T/LK65),SUM<65),WVL<  1  6  ) ,  HWVL ,  ALBEtX  1S>,BS<  1S>,  BAS< 

+  BE<  16),SINGUIV,PF<65),LLMAX  BAS( 

COMMON,''FAHTXSD<  3  ) ,  UV ,  GAMMA ,  ELD<  2  ) ,  STH,  FAC ,  AL I M ,  THV ,  T AU ,  EL<  2  ),  BASC 

*ALB(2),ZG,DMAX  BAS( 

C0MM0N/FGELXXA<3),D,NSCA  BASI 

COMMON/FUD/AKM ,  R<  3 , 3  ) ,  AKSQ ,  XD<  3  ) ,  ASQ<  3  > ,  P,E<  3 , 3  > ,  A<  3  )  B AS  ( 

C0MM0N/C0NB/'X<  1  00),  Y<  1  00)  BAS( 

C0MM0NXHITXUDS,THSP,RS<3,3),XS<3),DSA,XV<3)  BASi 

DIMENSION  NM< 1 0),TPU<7>,SS<3)  BAS( 

DIMENSION  IAL<7),DAT<7), IOR< 1 0)  BA£( 

DATA  IAL/2HPA  ,2HS0  , 2H0E  ,2HCL  ,2HGR  , 2HPU  ,2HG0  /  BAS( 

DATA  IZEROXO/  BASi 

THIS  SUBROUTINE  CALCULATES  STEADY  STATE  AND  TIME-DEPENDENT  DIRECT  BASi 
AND  MULTIPLY  SCATTERED  POWER  INTO  A  DETECTOR  BY  AN  ELLIPSOIDAL  BASi 
AEROSOL  CLOUD  WITH  GROUND  PLANE,  FOR  A  LASER  SOURCE.  THt  DETtCTORBAfi 
AND  SOURCE  MAY  HAVE  ANY  LOCATIONS,  LOOK  ANGLES,  AND  CONE  OF  VIEWX  BASi 
BEAM  SPREAD/WAVELENGTH.  THE  AEROSOL  CLOUD  MAY  HAVE  ANY  ORIENTA-  BASi 
TION,  SIZE,  AND  SCATTERING  PHASE  FUNCTION  <ARBITRARY  NORMALIZA-  BASi 

TION),  IN  A  COORDINATE  SYSTEM  WITH  ORIGIN  AT  THE  CLOUD  CENTER,  BASI 

WITH  Z-AXIS  VERTICAL,  X-AXIS  EAST,  AND  V-AXIS  NORTH.  THE  GROUND  BASi 
PLANE,  ASSUMED  AN  ISOTROPIC  REFLECTOR,  MAY  HAVE  ANY  ALBEDO,  AND  BASi 
MAY  OR  MAY  NOT  INTERSECT  THE  AEROSOL  CLOUD.  BASi 

4.  I*  til'*  I*  BASI 

BASi 

■**  INPUT  DATA  CARDS  ARE  READ  IN  AH  ORDER-IHDEPENDENT  MANNER,  WITH  BASi 

**  A  FOUR-LETTER  IDENTIFIER  IN  COLUMNS  1-4  OF  EACH  RECORD.  DATA  BASi 

**  ON  EACH  CARD  IS  READ  IN  UNDER  THE  FOLLOWING  FORMAT  ;  BaSI 

< A4, 1X,7<E9.4, 1X>).  NOTE  THAT  INTEGER  VARIABLES  IN  THE  PROGRAM  BASi 

*•*  MUST  BE  INPUT  AS  REAL  NUMBERS  IN  THIS  INPUT  SCHEME  .  .  .  THEY  ARE  BASi 

Later  fixed  to  the  integer  type.  basi 


CARD  identifier  i  PART  BASi 

VARIABLES  READ  !  N1,N2,ITIME  BASi 

N1=NUMBER  OF  PARTIAL  OUTPUTS  DESIRED,  FOR  A  GIVEN  RUN 
N2=NIJMBER  OF  PHOTONS  TO  BE  USED  FOR  EACH  PARTIAL  CALCULATION  BA-.( 

BASi 

NOTE  *•  FOR  CERTAIN  DETECTOR  CONDITIONS,  AND  WITH  NORMAL  BIASING,  BASi 
AS  MANY  AS  100,000  PHOTONS  MAY  BE  NEEDED  TO  OVERCOME  LARGE  BASi 
STATISTICAL  FLUCTUATIONS  IN  FIRST  ORDER  SCATTERING  RETURNS.  BASi 
SUCH  CONDITIONS  ARE  DEFINED  BV  THE  FOLLOWING  CHARACTERISTICSBASi 
<A)  THE  DETECTOR  IS  IN  A  MONOSTATIC  LIDAR  CONFIGURATION.  BASi 

<B)  THE  DETECTOR  IS  WITHIN  10  METERS  OF  THE  CLOUD  < OR  IS  INSIDE  BASi 

OF  IT).  BASi 

<C)  THE  CLOUD  IS  NOT  OPTICALLY  THICK  ALONG  THE  LOOK  DIRECTION  DASi 
<OPTICAL  DEPTHS  LESS  THAN  10).  BASI 

♦  IN  ORDER  TO  ATTAIN  MORE  RAPID  CONVERGENCE  OF  FIRST  ORDER  RETURN  BASi 

POWER  UNDER  THE  ABOVE  CONDITIONS,  A  DIFFERENT  BIASING  SCHEME  IS  BASi 

USED.  THE  SPECIFIC  CONDITIONS  WHICH  TRIGGER  THIS  ALTERNATE  MODE  BASi 

ARE  THE  FOLLOWING  :  BASi 

<A>  THE  DOT  PRODUCT  OF  THE  SOURCE  APERTURE  SURFACE  NORMAL  AND  BASi 

THE  DETECTOR  APERTURE  SURFACE  NORMAL  IS  GREATER  THAN  0.99.  BASi 

<B)  THE  DISTANCE  OF  THE  DETECTOR  APERTURE  FROM  THE  NEAREST  BASi 

CLOUD  SURFACE  < AS  SEEN  ALONG  THE  DETECTOR  NORMAL)  IS  LESS  BASi 
THAN  OR  EQUAL  TO  10  METERS  <0.01  KM).  BASi 

<C>  THE  SEPARATION  OF  SOURCE  AND  DETECTOR  APERTURE  CENTERS  IS  BASi 
LESS  THAN  OR  EQUAL  TO  10  TIMES  THE  DETECTOR  APERTURE  BASi 

RADIUS.  BASi 
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o  n  o  or*  r*  o  o  o  r*  o  n  o  o  o  o  o  n  r»  o  o  r*  o  o  o  o  n  n  n  r*  or  •  no  noon  n  r^n  o  o  o  r»r.  o  i  >  o  c>  c>  c>  r>  r*  o  o  o  o  o  n  o  n  r-  r*  o  r  •  c>  r 


THE  NORMAL  HMD 


C***  THE  MAIN  DIFEERNCES  WHICH  WILL  BE  OBSERVED  BETWEEN 
C  ALTERNATE  BIASING  MODES  ARE  THE  FOLLOWING  ; 

'■  <A;  THE  FIRST  ORDER  RETURN  POWER  IN  THE  EARLIEST 

BE  EXTREMELY  STABLE  IN  THE  ALTERNATE  MODE , _ 

ONLY  THE  EARLIEST  FIRST  ORDER  SCHilERING  RtSULTS  WILL  BE 
STRONGLY  AFFECTED. 

LATER  FIRST  ORDER  RETURNS  AND  ALL  HIGHER  ORDER  RETURNS 
HAVE  NEGLIGIBLY  POORER  CONVERGENCE. 

■*■**  IN  ORDER  TO  OBSERVE  CONVERGENCE  OF  THE  FIRST  ORDER  STEADY-STATE 


.  b  ; 


c,  L  ; 


TIME  BOX  WILL 


WILL 


BAS 
BAS 
BAS 
BAS 
BAS 
BAS 
BAS 
kpS 
BAS 
BAS 
BAS 
BAS 
BAS 
PAS 
B  WS 

ITIME«OVERALL  RUN  NUMBER  FOR  THIS  SET  OF  PARAMETERS.  FOR  EXAMPLE. BAS 
ITIME=1  MEANS  THE  FIRST  RUN,  ITIME=3  MEANS  THAT  THE  RESULTSEAS 
OF  THE  TWO  PREVIOUS  RUNS  WILL  BE  COMBINED  WITH  THIS  3RD  RUNBAS 

-  BAS 

CARD  IDENTIFIER  :  SORC  BaS 

VARIABLES  REaD  ;  XS<  1  > ,  XS<  2  !) ,  XS<  3  !) ,  THE3 ,  PHIS ,  ASMM  BA 

<XS<K),K=1 ,3)=S0URCE  XYZ  COORD  I HATES< KM )  BAS 

THES,PHIS  =  < POLAR, AZIMUTHAL  )ANGLES< DEG)  OF  SOURCE  BEAM  AXIS  BAJ 

ASMM=RADIUS  OF  SOURCE  APERTURE< MM ) .  THE  SOURCE  BEAM  SPREAD  ANGLEBAS 
THSP'  IS  TAKEN  BY  THE  PROGRAM  AS  THE  DIFhRACTION  LIMIT  FOR  BhS 
THIS  APERTURE.  IF  YOU  SET  ASMM=0.,  THE  PROGRAM  PUTS  THSP=0 
IF  YOUR  SOURCE  PHOTONS  WOULD  NOT  INTERSECT  THE  CLOUD  OR  THE 
GROUND,  THE  SUBROUTINE  NOTIFIES  YOU,  AND  RETURNS. 


RETURN  POWER  TOWARD  A  STABLE  VALUE,  IT  IS  SUGGESTED  THAT  THE  USER 
UTILIZE  THE  PARTIAL  OUTPUT  OPTION.  AS  AN  EXAMPLE,  IF  10,000 
PHOTONS  ARE  REQUIRED,  SET  N1=10  AND  H2=1,000.  THIS  SELECTION  WILL 
RUN  10  X  1,000  =  10,000  PHOTONS  AND  HILL  OUTPUT  RETURN  POWER 
RESULTS  AFTER  EACH  BATCH  OF  1,000  PHOTONS. 


CARD  IDENTIFIER  ;  DETR 

VARIABLES  READ  !  XD< I  >, XD< 2 >, XD< 3  ), THED, PHID, THEV, ACM 
<XD(K),K-1 ,3)=DETECT0R  XYZ  COORD  I NATES< KM  ) 

THEO,PHID«><POLAR,AZIMUTHAL)ANGLES<DEG)  OF  DETECTOR  LOOK  AXIS 
THEV=DETECTOR  CONE  OF  VIEW  HALF-ANGLE< DEG > 

ACM=RADIUS  OF  DETECTOR  DISK<CM) 

IF  YOUR  DETECTOR  POINTS  SKYWARD,  OR  IF  NEITHER  YOUR  SOURCE  NOR 
YOUR  DETECTOR  LOOK  INTO  THE  CLOUD,  THE  SUBROUTINE  NOTIFIES  YOU, 
AND  RETURNS. 

CARD  IDENTIFIER  i  CLDS 

VARIABLES  READ  :  A< 1  ) , A< 2  ) , A< 3  ) , THE , PHE , PSE , ISO 
<A<K),K=1 ,3)=ELLIPS0IDAL  CLOUD  PRINCIPAL  HALF-AXES< KM ) 
THE,PHE,P3E=ELLIPS0ID  EULER  ANGLES-:  DEG ) ,  WHERE  PHE'  IS  THE  FIRS 
ROTATION,  ABOUT  THE  Z-AXIS,  'THE'  IS  THE  NEXT,  ABOUT  THE  NEW 
Y-AXIS,  'PSE'  IS  THE  LAST,  ABOUT  THE  NEW  Z-A.XIS. 

ISO=AEROSOL  IDENTIFICATION  NUMBER,  TO  COMPARE  WITH  THE  'ID' 
PARAMETER . 

CARD  IDENTIFIER  :  GRND 
VARIABLES  READ  :  ZG,ALBG 
ZG=Z-COORDINATE  OF  GROUND  PLANE< KM  ) 

ALBG=GROUND  PLANE  REFLECTIVITY  0.<ALeG<1. 

IF  YOUR  ZG  IS  SUCH  THAT  THE  GROUND  PLANE  IS  ENTIRELY  ABOVE  THE 
CLOUD,  THE  SUBROUTINE  INFORMS  YOU,  AND  RETURNS.  IF  YOUR  ZG  IS 
NEGATIVE,  AND  SO  LARGE  THAT  NO  GROUND  REFLECTIONS  WILL  RETURN  TO 
THE  DETECTOR  WITHIN  THE  TIME  LIMIT  SET  BY  THE  SUBROUTINE,  THE  SUB 
ROUTINE  SETS  ALBG=0.  IF  YOUR  SOURCE  IS  BELOW  THE  GROUND  PLANE, 
THE  SUBROUTINE  PUTS  THE  SOURCE  OH  THE  GROUND  PLANE,  AT  YOUR  XY 
COORDINATES,  AND  NOTIFIES  YOU. 


CARD  IDENTIFIER 
VARIABLES  READ 
<TPU<  J>,  J*1 ,7) 
YOU  CAN  INPUT 
ENTRY  MUST  BE 
CARLO  PROBABI 
PULSES,  AND, 
THE  DETECTOR, 
ORDER  OF  MULT 


!  PULS 

TPU<  1  ),TPU<2),  .  .  .  ,TPU<7) 

SOURCE  PULSE  OURATIONS< USEC ) 

AS  MANY  AS  SIX  DIFFERENT  PULSE  LENGTHS.  THE  LAST 
BLANK<ZERO).  THE  SUBROUTINE  CONVuLUTES  THE  MONTE 
LITY  PER  UNIT  TIME  DATA  WITH  EACH  OF  THESE  SQUARE 
FOR  EACH  PULSE,  WRITES  THE  TIME-DEPENDENT  POWER  TO 
FOR  UNIT  SOURCE  PULSE  POWER,  FOR  EACH  SIGNIFICANT 
IPLE  SCATTERING,  AND  FOR  THE  TOTAL  OF  ALL  ORDERS. 


,  BAS 
BAS 
BAS 

ba:-; 

BAS 

BAS 

BAS 

BAS 

BAS 

BAS 

BAS 

BA 

BA 

BAS 

BAS 

BAS 

BAS 

TOAS 

LAS 

BAS 

BAS 

BAS 

BA 

BAS 

BAS 

BAS 

BAS 

BAS 

BAS 

BAS 

-BAS 

BAS 

BAS 

BAS 

BAS 

BAS 

BAS 

BAS 

BAS 

BAS 

BAS 

BAS 

BAS 

BAS 

BAS 


Cl  M  1  0 
0 1  <! '' 
0  M ^ 
01-^4  ij 
0  1  45  0 
01440 
0  •  4  r'  0 
0  1  4  S  0 
01430 
ill  500 
01  51  0 
01520 
01  53  0 
0  •  54  0 
i-'l  55  0 

0 15  6  0 
01  57  0 
0-580 
Ol  d9u 

0  •  b  0  0 

0161  u 
0162  0 
016  3  0 
01  64  0 
01  65  0 
0  1  66  0 
01670 
1.1 '68  0 
0  -  69  0 
.70  0 
0 ' 7  ■  0 
0  172"' 
6-730 
01740 
01  75  0 
0 ' 76  0 
0  1  77  0 
0-780 
0  1  790 
0  1  8  0  0 
0181  0 
01820 
0-830 
O' 84  0 
0  850 
0'860 
0  '.7  0 

0  '  :i  0 

0 1  ■;  9  0 
0  ■  0  0 

01910 
01  92  0 
01930 
01940 
C-  95  0 
0  1960 
01  970 
01980 
01990 
02000 
02  01  0 
02  02  0 
02030 
02040 
02050 
02  06  0 
02  07  0 
0  1080 
02090 
021  00 
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C  ChRD  identifier  !  Gu 

C  VARIABLES  READ  :  NONE 

C  RUN  TERMINATION  CARD  (MUST  BE  LAST  CARD  READ). 

C - 

IERR-0 

THE  FOLLOWING  STATEMENT  MAY  HEED  TO  BE  CHANGED  OR  ELIMINATED 
C***  FOR  USE  ON  NON-HP1000  COMPUTERS. 

C 

SEED0=735. 34829 
NDIM=1 00 
ND1=NDIM-1 
DTAUM=0 . 2 
GAMMA=EXCO 
SINGwv=uiAVE 

INPUT  DATA  INITIALIZATIONS, 


600 

C 

c 


IFc I2ER0 . HE . 0 j  GO  TO  600 

N1=0 

N2=0 

ITIME=0 

ISO=0 

DO  599  LL=1 .3 
X3<LL  )=0 . 

XD<LL)=0. 

LL  >=0  , 

TPU<LL  >=0, 

TPU<  LL+3  >=0 . 

TPU<7>=0, 

THES=0 , 

PHIS=0, 

ASMM=0 , 

THED=0, 

PHID=0, 

THEV=0. 

ACM=0 . 

THE=0, 

PmE=0 . 

PSE=0, 

2G=0 . 

ALBC=0 . 

LLMAX=65 

I2ER0=1 

CONTINUE 

READ  BASCAT  DATA  SET  RECORDS  UNDER  CARD-INDEPENDENT  FORMAT 
DO  700  K=1 ,7 

READ< IOIN,610)  lA, IA1 ,<DAT< I ), 1=1 ,7> 

F0RMAT<2A2, 1X,7<E9.4, IX)) 

DO  615  JJ=1,8 

IF< IA,NE.IAL< JJ))  GO  TO  615 
INOPT=JO 

IF< IN0PT.EQ,7)  GO  TO  701 

GO  TO  620 

CONTINUE 

IF<<K.EQ.7).AND,< JJ.EQ.8))  GO  TO  697 

GO  TO  695 

CONTINUE 

GO  TO  <621 ,622, 623, 624, 625, 626), INOPT 
N1-IFIX<DAT< 1 )) 

N2»IF1X<DAT<2)) 

1T1ME=IFIX<DAT<3)) 

GO  TO  700 
XS< 1  )»DAT< 1  ) 

XS<2)=DAT<2) 

XS<3)-DAT<3) 

THES-DAT<4> 

PH1S=DAT<5) 


GAS  021 1 0 
BAS  j2 1 2 0 
BAS0Z1 30 
■BAS  02  140 
BAS02150 
BAS02160 
BAS021 70 
BAS02 180 
BAS02190 
BAS 022 00 
BAS 0221 0 
BAS02220 
&AS02230 
BAS  0224  0 
BAS02250 
BAS 02260 
BAS 02270 
BAS 0228 0 
BAS02290 
BAS 023 00 
BAS02J ■ 0 
BAS 02320 
BAS028.50 
BAS 02340 
BAS02350 
BAS02360 
BAS02370 
BAS 02^80 
BAS02j90 
BAS 024 00 
BAS  024 i 0 
BAS  02420 
BAS 02430 
BAS02440 
BAS0245U 
BAS 02460 
BAS02470 
BAS 02480 
BAS02490 
BAS  025 00 
BAS  0251  0 
BAS02520 
BAS 02530 
BAS02540 
BAS 02550 
BAS02560 
t-  '^  0257  0 
BAS025S0 
BAS02590 
BAS02600 
BAS0261 0 
BAS02620 
BAS02630 
BAS 02640 
&ASu2650 
BAS02660 
8AS02670 
BAS02680 
BAS  02690 
BAS02700 
BAS0271 0 
BAS02720 
BAS02730 
BAS02740 
BAS 02750 
BAS02760 
BAS02770 
BAS02780 
8ASG2790 
BAS02800 
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ASMM  =  DAT<  6  > 

BAS029 1 0 

GO  TO  700 

BAS  0282:' 

623 

XDO 1  )=DAT< 1  ) 

BAS0285ij 

XD<  2  >=DAT<  2  ) 

BAS  0284  0 

XD'.  j  >=DAT<  3  > 

BAS 02650 

THED=DAT<4> 

BAS  0286  0 

PHID=DAT<:5> 

5HS02b«^0 

THEV=DATf6  > 

BAS  0288  0 

ACM  =  DAT<  7  > 

GO  TO  700 

BAS  029 0  0 

b^4 

A< 1 j=DAT< 1  > 

BAS  0291 0 

A<  2  :)=DAT<  2  ) 

BAS  0292  0 

A'.  3  ;=DAT';  3  > 

BAS0i;930 

THt  =  DAT<:  4  > 

BAS  0294  0 

PHE  =  DAT<  s  ■; 

b«S  u2b5u 

PSE  =  DAT<  6  > 

BAS  0296  0 

Ii>Q=IFIX<  DAT<  7  )  ; 

BAS  0i;9 0 

GO  ;ij  70  0 

BAS  0298  0 

625 

2G=DAT< 1  ; 

BAS  0299  0 

ALBG=DATt  2  > 

BAS  030 00 

GO  lO  700 

BASC'30  i  0 

626 

CONTINUE 

BAS03020 

DO  627  NN=1,7 

BAS  0.5  0 

627 

TPU<  NN  )=DAT<  NN  > 

BAS03040 

GO  TO  700 

BAbUJiOSu 
BAS 03 060 

tRftOR  RETURNS 

BAS  0307  0 
BASO  '-08  0 

6^5 

CONTINUE 

BAS 03  09  0 

WRITE< I00UT,696 ) 

BAS  031 0  0 

696 

FORMAT< 1H0,20X,89H***BASCAT  ERROR*** 

INPUT  CARD  DETECTED  WHICH  DCEBAS031 ■ 0 

♦S  NOT  MATCH  ANY  CORRECT  INPUT  IDENTIFIERS  /> 
IERR=f 
GO  TO  777 
697  CONTINUE 

WRITE< lOOUT, 698  > 


BAS0312n 
BAS  031 3  0 
BAS03140 
BAS  03 150 
BAS03160 


698  f6rmAT<  1H0,^0X.66H*‘*’*BASCAT  ERROR***  TOO  MANY  INPUT  CARDS  OR  GO  SEBAS03170 


+NTINEL  NOT  PRESENT  7) 

700  CONTINUE 

701  CONTINUE 

C***  GEOMETRICAL  OPTION  DATA  TRANSFER 
C 

IF<IGEOSW.NE. 1 )  GO  TO  111 
DO  110  1=1,3 

XS< I  )=PTS< I+6)-PTS< 1  +  12) 

110  XD< I  )=PT3< I+3>-PTS< I  +  12> 

1  1  1 


CONTINUE 

GENERATE 


INTERPOLATED,  RENORMALIZED  PHASE  FUNCTION 


4=  ♦♦ 


CALL  PFUNC<ISO) 

IFOjAMMA.EQ, 0, 0)  GAMNA=BE< 1 > 

ALBEDO=ALBEO< 1  ) 

REWIND  IPHFUN 
ALB< 1 >=ALBEDO 
ALB<2)=ALBG 

DETERMINE  POWER  OF  2  <KMAX)  CORRESPONDING  TO  NUMBER  OF  PHASE 
FUNCTION  VALUES  PRESENT. 

LMAX=LLMAX 

LMM1=LMAX-1 

KMAX=IFIX<  ALOG<FLOAT<LMMl >  >70 , 693147) 


lC 


SPEED  OF  LIGHT  < KM7M1 CROSECOND > 


BAS03180 
BAS03190 
BAS  032 0  0 
BAS032 1 0 
B  A  S  0  3  ei  0 
BAS 03230 
BAS  0324  0 
BAS03250 
BAS03260 
BAS  0327  0 
BAS  03c:  S  0 
BAS 03290 
BAS  033 0  0 
BAS 0331 0 
BAS  0332  0 
BAS03330 
BAS03340 
BAS 03350 
BAS  0336  0 
BAS03370 
BAS 0538 0 
BAS03390 
BAS 034 00 
BAS  0341  0 
BAS03420 
BAS  03430 
BAS  03440 
BAS 03450 
BAS 03460 
BAS 03470 
BAS  0  >480 
BAS03490 
BAS03500 


CC  =  0 . 3 

THV=PIRAD*THEV 
IF<THV.LE. 1 .E-30>  THV»0. 
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Uv=COS( TMv  > 

BAS035 1 0 

c 

BA' 03d20 

SET  RANDOM  NUMBER  SEED 

BAb03530 

c 

BAS03540 

SEED=<2*ITIME-1 ;*SEED0 

BAS03550 

AKM=ACM*1 .E-5 

BAS035fe0 

AKSQ=AkM**2 

BAS0j570 

c 

BAS035.S0 

C4> 

SET  MINIMUM  DISTANCE  ALIM  (AND  ITS  SQUARE  BLIM.)  SEPARATING 

BAS0359CI 

THE  DETECTOR  DISK  AND  A  PHOTON  SCATTERING  POINT. 

BAS03600 

c 

BAS0361 0 

ALIM=AKM>»1  0, 

BAS 03620 

BLIM=ALIMh'>»2 

BAS036b0 

PAC  =  THV>*AKSQ,''8  . 

BAS 03640 

BT=,61*yAVE*1 ,E-3 

BAS  0465  0 

THSP=u, 

BAS 03660 

c 

BAS0j670 

DETERMINE  DIFFRACTION-LIMITED  SOURCE  BEAMSPREAD 

BAS03680 

c 

BAS 04690 

IF<  ASMM  .  GT  .  0  .  )THSP*=BT/'ASMM 

BAS 047 00 

c 

BAS  04? 1 0 

GENERATE  ROTATION  MATRIX  RE<  >  FOR  CONVERSION  FROM  STANDARD 

BAS03720 

BAS03730 

FRAME  OF  REFERENCE  TO  CLOUD  FRAME  OF  REFERENCE 

c 

BAS03740 

CALL  MATRX<THE,PHE,SS,R) 

BAS 03750 

AT=PIRAD*PSE 

BAS03760 

IF< AT.LE . 1 .E-30 j  AT=0. 

BAS03770 

DO  1  1=1,3 

BAS03780 

DO  1  J=1 .3 

BAS03790 

1 

RS<I,J)=b. 

BAS03800 

RS<  1  ,  1  )=COS<AT> 

BAS0381 0 

RS< 1 ,2>=SIN< AT) 

BAS03820 

RS<2, 1 >=-RS< 1,2) 

BAS03830 

RS<2,2)=RS<  1,1) 

6AS03840 

RS<3,3)=1 . 

BASOSdSO 

DO  2  1=1,3 

BAS03860 

DO  2  J=1 ,3 

BAS03870 

RE< I, J)=0. 

BAS03880 

DO  2  K=1 ,3 

BAS03890 

2 

RE<  I ,  b  >*RE<  I ,  J  )+RS<  I ,  K  )>*R<  K,  J  ) 

BAS03900 

c 

BAS 0391 0 

C'*** 

GENERATE  ROTATION  MATRIX  RS<  )  FOR  CONVERSION  FROM  SOURCE 

BAS 03920 

c*** 

CONE  FRAME  OF  REFERENCE  TO  STANDARD  FRAME  OF  REFERENCE 

BAS 03930 

c 

BAS 03940 

CALL  MATRX<THES,PHIS,SS,RS) 

BAS03950 

c 

BAS03960 

c>*** 

ECHO  INPUT  PARAMETERS 

'5AS03970 

c 

enSObSSO 

WRITE  <IOOUT,6800) 

BAS03S90 

WRITE  <  IOOUT,4800) 

BAS04000 

WRITE  < IOOUT,4900) 

BAS0401 0 

WRITE  < IOOUT,5000) 

BAS04020 

WRITE  < IOOUT,4800) 

BAS04030 

WRITE  <  IOOUT,4700) 

BAS04040 

WRITE  < I00UT,51 00) 

BAS 04 050 

IF  <ISO.EQ.O)  WRITE  <IOOUT,5200) 

BAS04060 

IF  <ISO.EQ.1)  WRITE  <100UT,5201> 

BAS04070 

IF  <IS0,EQ.2)  WRITE  <IOOUT,5202) 

BAS04080 

IF  <IS0.EQ.3>  WRITE  <100UT,5203) 

BAS04090 

IF  <IS0,EQ.4>  WRITE  <IO0UT,5204> 

BAS041 00 

IF  <IS0.EQ.5)  WRITE  <IOOUT,5205) 

BAS041 1 0 

IF  <IS0.EQ.6)  WRITE  <100UT.5206) 

BAS04120 

IF  <:IS0.EQ.7)  WRITE  <100UT,5207) 

BAS04130 

IF  <IS0.EQ.8>  WRITE  <100UT,5208> 

BAS  041 40 

IF  <1S0,EQ.9)  WRITE  <IOOUT,5209) 

IF  <I80.EQ.10>  WRITE  <IOOUT,S210> 

BAS04150 

BAS04160 

IF  < ISO. EG. 11)  WRITE  <I00UT,5211) 

BAS04170 

IF  <IS0,EQ.12)  WRITE  <I00UT.5212> 

BAS04180 

WRITE  <IOOUT,5600>  WAVE, ALBEDO 

BAS04190 

WRITE  <IOOUT,5700)  GAMMA 

BAS04200 

57 


WRITEc lOOUT, 5601 > 

UPITE< IOOUT,5602> 

URITE< IOOUT,5603  ) 

WRITE< IOOUT,5701 ) 

UIRITE<  IOOUT,57  02><XS<K),K=1 ,3) 

WRITE<  IOOtJT,570«l  >THES 
IJRITE<  IOOUT,5705)PH1S 
URITE< lOOUT, 5703  )ASM« 

URITE< 100UT,5706)THSP 
WRITE  < IOOUT.5900) 

WRITE  <IOOUT,6000)  THEV 
WRITE  < I00UT,61 00>  ACM 
WRITE<  IOOUT,6201  KXD<K),K=1 ,3> 

WRITE  <IOOUT.6400)  THED 
WRITE  <IOOUT,6500)  PHIO 
WRITE< 100UT,6501  ) 

WRITE< lOOUT, 6502  >ZG, ALBG 
DO  1 0  K=1 ,3 
10  A3Q<K)=A<K>>**2 
Du  12  K= 1 , 3 
12  Y<K>=A<K>>f2.fGAMMA 

DETERMINE  LARGEST  OPTICAL  DEPTH  PRESENT  IN  AEROSOL  CLOUD 

^  CALL  GMAX<3,TAU) 

C 

C***  SET  TIME  AND  DISTANCE  INCREMENTS  AND  LIMITS 

NTMAX=*50 
D=TAU/'GAMMA 
DELD=5.'»D/'NTMAX 
DELT=DELD/CC 
DMAX=5 . 5*D 
C 

BEGIN  CLOUD  SUBBLOCK 

C  THE  FOLLOWING  BLOCK  OF  WRITE  STATEMENTS  MUST  BE  UNCOMMENTED 
C  IN  ORDER  TO  OUTPUT  DATA  TO  A  USER-DEFINED  PLOT  FILE  <NPLOTU>. 

C 

C  THE  OUTPUT  QUANTITIES  IN  THIS  BLOCK  ARE  THE  FOLLOWING  ! 

C  WAVE  =  WAVELENGTH  < MICROMETERS  ) 

C  ISO  =  AEROSOL  TYPE  <VALID  RANGE,  0-12) 

C  TAU  »  OPTICAL  DEPTH  ALONG  LONGEST  AXIS  OF  CLOUD  ELLIPSOID 

C  N1  =  NUMBER  OF  PARTIAL  RUNS  WITHIN  THIS  BASCAT  RUN 

C  XS<  )=  SOURCE  XY2  POSITION  ARRAY  < KILOMETERS) 

C  THES  =  SOURCE  VECTOR  POLAR  ANGLE  < DEGREES.) 

C  PHIS  =  SOURCE  VECTOR  AZIMUTHAL  ANGLE  < DEGREES) 

C  ASMM  =  SOURCE  APERTURE  RADIUS  < MILLIMETERS) 

C  THSP  =  HALF-ANGLE  OF  SOURCE  DIFFRACTION  CONE  < RADIANS) 

C  XD<  )=  DETECTOR  XYZ  POSITION  ARRAY  <KILOMETERS) 

C  THED  -  DETECTOR  VECTOR  POLAR  ANGLE  < DEGREES) 

C  PHID  -  DETECTOR  VECTOR  AZIMUTHAL  ANGLE  <DEGREES) 

C  ACM  =  DETECTOR  APERTURE  RADIUS  <CENTIMETERS ) 

C  THEV  *  HALF-ANGLE  OF  DETECTOR  FIELD  OF  VIEW  <DECREES) 

C  A<  )  «  CLOUD  ELLIPSOID  PRINCIPAL  HALF-AXIS  ARRAY  < KILOMETERS) 

C  ALB< 1  )=  SINGLE-SCATTERING  ALBEDO  OF  CLOUD  AEROSOL 

C  ALB<2)-  ALBEDO  OF  GROUND  PLANE 

C 

C  WRITE<NPL0TU.91 1 1  )  WAVE, ISO, TAU, N1 
C91 1 1  F0RMAT<E9.4, IX, 12, 1X,E9.4, 1X,2< 12, IX)) 

C  WRITE<NPL0TU,9222)XS< 1  ), XS< 2  ), XS< 3 ), THES, PHIS, ASMM, THSP 

C  WRITE<NPL0TU,9222)XD< 1  ) , X0< 2  ), XD< 3  ), THED, PHID, ACM , THEV 
C9222  FORMAT< 12<E9.4, IX)) 

C  WP.ITE<NPL0TU,9222)  A<  1  ),  A<  2  ),  A<  3  ) ,  ALB<  1  ) ,  ALB<  2  > 

WRITE  < IOOUT,6900) 

WRITE  < IOOUT,7000)<A<K),K-1 ,3) 

WRITE  <  I00UT,71  (IO)THE,PHE,PSE 


BAS  0421  " 
BAS0422r 
BA304231' 
BASC4240 
BAS04250 
BAS  0426  0 
BAS  04 27  0 


BASC4230 
BAS04290 
BAS 043 00 
BAS0431 0 
BAsn4T2n 

BAS64336 

BAS  0434  0 
BAS  04 0 
BAS04360 
BAS04370 
BAS04380 
BAS04390 
BASC44O0I 
BAS0441 0 
BAS  0442  0 
BAS 04430 
BASu4440 
BAS04430 
BAS04460 
BAS 044 70 
BAS 04 480 
BAS  0449  0 
BAS 045 00 
BAS045 1 0 
BAS 04520 
BAS04530 
BAS04540 
BAS04550 
BAS 04 560 
BAS04570 
BAS04580 
BAS04590 
BAS04600 
BAS0461 0 
BAS  0462  0 
BAS04630 
BAS04640 
BAS 04650 
BASO^iSSO 
BAS04670 
BAS046.-?0 
BAS 0469 M 
BAS04700 
BAS0471 0 
6AS0472C 
BAS0473U 
BAS 04740 
BAS 04750 
BAS 04760 
BAS04770 
BAS04780 
BAS04790 
BAS04S00 
BAS048t  0 
BAS04820 
BAS04830 
BAS04840 
BAS 04850 
BAS04860 
BAS04870 
BAS04880 
BAS04890 
BAS04900 
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c 

c 

c 

c**** 

c 


16 

C 


c 

c*** 

c 

c 

c 


c 

c 


1  i 


c 

c 


URITt  <  lOOUT/  7200  )<  y<  K  ),  k*1 , 3  > 

GENERATE  ROTATION  HATRIX  R<  )  FOR  CONVERSION  FROM  DETECTOR 
CONE  FRAME  OF  REFERENCE  TO  STANDARD  FRAME  OF  REFERENCE 

CALL  MATRX<THED,PHID.SD.R) 

SET  LIMIT  N3CAM  ON  HIGHEST  SIGNIFICANT  SCATTERING  ORDER  <NSCAM-1> 

NSCAM=3 . 0*ALBEDO*TAU+2 . 0 
IF  <NSCAM.GT. 1 0;  NSCAM»10 
I  F<;  NSCAM  .  LT  .  3  >NSCAM=3 
NSCA1=NSCAM-1 
AT=0  . 

DO  4  i<=  1 , 3 

AT=AT+RE<  K  ,  3  )**2/'ASQ<  K  ) 

BT=1 . -AT*2G 
IF<BT.LE. 0, >GO  TO  4002 
A  I  =ZG+D 

IF<AT.GT,  0,  ;)Gli  to  3 
ZG=-D 

WRITE< IOOUT,9004)ZG 
CONTINUE 

IF<XS<3>,GE.ZG>G0  TO  16 
XS<  j  >=2G 

URITE< IOOUT,9003)XS<3) 

CONTINUE 

DETERMINE  DISTANCES  ELDU ELD<2>  FROM  DETECTOR  TO  NEAREST  AND 
FARTHEST  CLOUD  BOUNDARIES  ALONG  DETECTOR  AXIS 


CALL  ELM<XD,SD,ELD) 

DETERMINE  DISTANCES  EL< 1 EL<2>  FROM  SOURCE  TO  NEAREST 
FARTHEST  CLOUD  BOUNDARIES  ALONG  SOURCE  AXIS 

CALL  eLM<X9,SS,EL> 

PERFORM  GEOMETRICAL  ERROR  CHECKS 

IF<<EL<2>.LE. 0. >.AND,<EL0<2>.LE, 0, >>GO  TO  4003 

IF<<EL<2).GT. 0. >.AND,<ELD<2>.GT, 0, >>GO  TO  6 

IF<EL<2).LE. 0. >GO  TO  7 

IF<ALB<2).LE. 0. >  GO  TO  4004 

IF<SD<3>.GE. 0. >GO  TO  4001 

AT=EL< 1 ) 

CT=<:ZG-XD<3)  VSD<3) 

GO  TO  9 
CONTINUE 

IF<ALB<2).LE. 0. )  GO  TO  4005 
IF<SS<3>.GT. 0, >00  TO  4000 
AT=<ZG-XS<3))/SS<3> 

GO  TO  8 
AT=EL< 1  ) 

DETERMINE  MINIMUM  POSSIBLE  TRAVERSE  DISTANCE  ELMIN 

CT=ELD< 1  ) 

BT=0. 

DO  11  K-1,3 
X<K>-XS<K)+AT*SS<K> 

Y<K>-XD<K>+CTkSD<K> 

BT=BT+<  X<  K  )-Y<  K  )  >>*»2 
IF<BT.LE. 1 .E-30)  BT=0, 

ELMIN-SORT<BT)+AT+CT 
IF<ELMIN.LT.AL1M>  ELMIN-ALIM 

DETERMINE  VIRTUAL  SOURCE  POINT  XV<  > 

DSA=0. 


AND 


BAS049i 0 
BAS  04920 
BAS0493  0 
BAS09940 
BAS  04950 
BAS04960 
BAS04970 
BAS049B0 
BAS04990 
BAS05000 
BAS0501  0 
BAS 05 020 
BAS05030 
BAS 05 040 
BASOt.050 
BAS05060 
BAS05070 
BAS05080 
BAS 05 090 
BAS  0^1 0  0 
BAS051 1 0 
BAS05120 
BASC5130 
BAS051 40 
BASOSi 50 
BAS05160 
BAS05170 
BASOSI 80 
6AS05190 
BAS05200 
BAS052 I  0 
BAS 05220 
6AS05230 
BAS05240 
BAS05250 
6AS05260 
BAS05270 
BAS05280 
BAS05290 
BAS 053 00 
BAS0531 0 
BAS 05320 
BAS05330 
BAS05540 
BAS05350 
BAS05360 
59505370 
Bas0538O 
BAS05390 
BAS05400 
6AS054 1 0 
BAS05420 
BAS 054 30 
BAS05440 
BAS05450 
BAS05460 
BAS05470 
SAS05480 
6AS05490 
BAS05500 
BAS0S51 0 
BAS05520 
BAS05530 
BAS05540 
BAS05550 
BAS05560 
BAS05570 
BAS055S0 
BAS05590 
BASC5600 
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ooo  oono  ooo  r>or»  ooo  ooo  ooo  oon  ooo  ono 


1700 

c 


IF<  hSMM  .  GT  .  0  .  >C»SA*h3MM*»  1  .  E-6/TAN<  TH6P  > 

DO  305  K=1 , 3 

XV<  K  )=XS';  K  >-DSA*SS<  K  ) 

DETERMINE  WHETHER  NEhR-CLOUD  lIDHR  BIASING  IS  NEEDED, 

DOTSD=0 . 

DOTXD=0, 

DO  47  KL=1,3 

D0TXD=D0TXD+<  XD<  KL  >-XS<  KL  )  >’*♦2 
D0TSD=D0TSD+S3<i<L  j*SD<  kL  > 

if<dotxc),gt.blim:)  dotsd=o. 

REWIND  kSTuR 
start  PHOTON  LOOPS 
Du  1  00  0  1 1  =  1  , N1 

check  TO  SEE  IF  THIS  IS  THE  FIRST  RUN  WITH  NO  PRIOR  RESULTS 

IF<< II .EQ. 1 >.AND.< ITIME.EO. 1 )>G0  TO  1303 

RELOAD  WITH  RESULTS  FROM  PREVIOUS  PARTIAL  RUN 

DO  1301  NSCA®1,NSCAM 
REAO<  KSTOR )ENC<  NSCA  ) 

DO  1301  II=1,NTMAX 
READ<  KSTOR  )EN<  NSCA .II) 

CONTINUE 
REWIND  KSTOR 
GO  TO  1302 
CONTINUE 

INITIALIZATION  FOR  FIRST  RUN 

DO  1300  N8CA»1 .NSCAM 
ENC<NSCA)»0. 

DO  1300  NT=1 .NTMAX 
EN<NSCA.NT>=0. 0 
CONTINUE 

LOAD  EXPECTED  CUMULATIVE  NUMBER  OF  PHOTONS 

DO  1 304  NS-1 .NSCAM 
ENC<NS>*ENC<NS)+N2 

DETERMINE  VECTOR  FROM  VIRTUAL  SOURCE  POINT  TO  DETECTOR 

DO  555  K=1 .3 
Y<K)=XD<K)-XV<K) 

START  INNER  PHOTON  LOOP 

DO  900  I2«=1.N2 

INITIALIZE  PHOTON  DIRECTION  AND  CALCULATE  DIRECT  BEAM 
CONTRIBUTIONS  < IF  ANV ) 

CALL  START<SS) 

IF<STH.GT. 0, )GO  TO  150 

GO  TO  900 

NSCA=«1 

START  MULTIPLE  SCATTERING  LOOP 

I2FLC-0 

ICOND=0 

NSCA=NSCA+1 

NEAR-CLOUD  LIDAR  BIASING  IS  ACTIVE  WHEN  lCOND-1 .  10  PERCENT 


BAS05S1 0 
BAS0562r- 
BAS05630 
BAS 05640 
BASOSbSO 
BAS  0566  0 
OASOwbi'  0 
BASOt'SSO 
SAS05690 
BAS05700 
BAS057 1 0 
BAS 05720 
BASu5730 
BAS05740 
BAS057d0 
BAS 05760 
BAS  057  <-  0 
BAS 05730 
USED  BAS 05,' 3  0 
BASOsSOO 
BASOsSI 0 
BASD5820 
BAS05830 
BAS0^S40 
BAS05S50 
BAS05860 
BAS05S70 
BAS05880 
BAS  0589  0 
BAS05900 
BAS059t  0 
BAS  0592 1"' 
BAS05950 
BAS05940 
BAS 05950 
BAS 05960 
BAS05970 
BAS  05980 
BAS05990 
BAS06000 
BAS0601 0 
BAS06020 
BAS060,50 
BAS06040 
BAS 06 050 
BAS 06 060 
BAS 06 070 
BAS06CS0 
BAS 06 030 
BAS06) 00 
BAS  061 1 0 
BAS  061 20 
BAS06 130 
BAS06140 
BAS06150 
BAS 06 160 
BAS06170 
BAS 06 180 
BAS06190 
BAS06200 
BAS062t  0 
BAS06220 
6AS06230 
BAS06240 
BAS 06250 
BAS 06260 
BAS06270 
BAS06280 
BAS062S0 
OF  ALLBAS06300 
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FIRST  ORDER  PHOTONS  USE  hN  ALTERNATE  HODE  OF  BIASING  IN  THIS 
SITUATION,  THE  REMAINING  90  PERCENT  ARE  NORMALLY  BIASED  IN  ALL 
ORDERS  , 

C 

IF<<N3CA.NE.2>,OR,<DOTSD.LE.0.99>.OR.<ELD< 1  > , GT . 0 . 01  )  >GO  TO  7  07 
ICOND=1 

IF<FLOAT< I2).LE.<FL0AT<N2>/10. >)I2FLG*1 
707  CONTINUE 

C*f*  MOVE  PHOTON  TO  NEXT  EVENT  POINT  VIA  BIASED  TRAVERSE  AND  DETERMINE 
C***  POWER  CONTRIBUTIONS 
C 

CALL  TRAVRS< JTVPE, I2FLG, ICOND> 

IF<<NSCA.EQ.NSCA1  ).OR.<STH.LE. 0.  >)GO  TO  900 

C***  DETERMINE  SCATTERING  DIRECTION  FOR  NEXT  TRAVERSE 

CALL  GAS<JTYPE) 


DETERMINE  BIASING  DIRECTIONS  FOR  NEXT  TRAVERSE 


C 

''  CALL  ELM<XA,SA.EL) 

IF<EL<2>.LE.EL< 1  )>GO  TO  900 
GO  TO  1700 
900  CONTINUE 
C 

END  MULTIPLE  SCATTERING  LOOP,  BEGIN  CONVOLUTION  BLOCK 


C 

C 


2201 

C 

C 


WRITE  PARTIAL  RUN  RESULTS  INTO  STORAGE  FILE  FOR  USE  BY  NEXT  RUN 

DO  2201  NSCA=1,NSCAM 
WR I TE<  KSTOR )ENC<  NSCA  ) 

DO  2201  II-1,NTMAX 
WR I TE< KSTOR >EN< NSCA, 11 > 

CONTINUE 
REWIND  KSTOR 

OUTPUT  PARTIAL  RUN  RESULTS  FOR  STEADY  STATE  POWER 


WRITE  <IOOUT,7400> 

WRITE< IOOUT,7500> 

WRITE< IOOUT,7600) 

PTOT*0, 

C  THE  FC  LOWING  STATEMENT  SHOULD  BE  UNCOMMENTED  IF  OUTPUT  TO 

C  A  USER-DEFINED  PLOT  FILE  <NPLOTU>  IS  DESIRED, 

C  NSCAM=  1  +  HIGHEST  SIGNIFICANT  ORDER  OF  SCATTERING 

C 

C  WRITE<NPL0TU,9333)  NSCAM 

DO  2110  NS=1, NSCAM 
PE-0. 

N31-NS-1 

DO  2115  NT-1 ,NTMAX 
2115  PE-PE+EN<NS,NT) 

PE-PE/'ENC<  NS> 

PTOT=PTOTfPE 

C  THE  FOLLOWING  STATEMENT  SHOULD  BE  UNCOMMENTED  IF  OUTPUT  TO 

C  A  USER-DEFINED  PLOT  FILE  <NPLOTU>  IS  DESIRED. 

C 

C  NS1  -  ORDER  OF  SCATTERING 

C  PE  -  OBSERVED  STEADY  STATE  POWER  FOR  THIS  ORDER 

C  ENC< )-  TOTAL  NUMBER  OF  PHOTONS  COUNTED  FOR  THIS  ORDER 

i  «#*»#«»»»«#*«#«»«««»  «««» 

WRI TE< lOOUT, 7700  )NS1 , PE , ENC<  NS >  * 

2110  CONTINUE 


BAS 0631 0 
BAS  ''632  0 
BASiifc33  0 
BAS06340 
BAS  0635  0 
BAS  06560 
BAS  0637  0 
BAS06.»d0 
BAS06390 
BA&06400 
BASUb4 1 0 
BAS  06420 
BAS06430 
BAS06440 
BAS0645U 
BAS06460 
BAS0647O 
BAS06480 
BAS06490 
BAS06500 
BAS  0651  0 
BAS06520 
BAS  06530 
BAS0654U 
BAS06530 
BAS06560 
BAS06570 
BASOeSBO 
BAS0659U 
BAS 066 00 
BAS  0661 0 
BAS06620 
BAS06630 
BAS06640 
BAS  06650 
BAS  0666  0 
BAS06670 
BAS066d0 
6AS06690 
BAS  067 00 
BAS0671 0 
BAS06720 
BAS06730 
BAS 06740 
BAS06750 
BAS  06760 
D^’S  0677  0 
BAi 06780 
BAS0679U 
BASOSdOO 
BAS0681 0 
BAS  06820 
BAS06830 
BAS06840 
BAS  06850 
BAS06860 
BAS06d70 
BAS06860 
BAS  06890 
BAS06900 
6AS0691 0 
BAS06920 
BAS06930 
BAS 06940 
BAS06950 
eAS06960 
BAS 06970 
BAS 06980 
BAS06990 
BAS07000 
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C  THE  FOLLOWING  STHTEMEHTS  SHOULD  BE  UNCOMMENTED  IF  OUTPUT  TO 

C  H  USER-DEFINED  PLOT  FILE  < NPLOTU >  IS  DESIRED. 

C  PTOT  «  OBSERVED  TOTAL  STEADY  STATE  POWER  < ALL  ORDERS) 

C9333  FORMAT< 12, 1X,2<E9.4, iX)) 

C  WR1TE< NPLOTU,  9222)  PTOT 

URITE< lOOUT, 7701 jPTuT 
DO  2500  NSCA*1,NSCAM 
C 

c***  DETERMINE  INDEX  OF  TIME  OF  LAST  NONZERO  POWER  VALUE  FOR  EACH 
C***  ORDER 

CALL  SMOOZ<NSCA,NO) 

NM<NSCA)=1+NO 
IOR<  N5CA  >‘*NSCA-1 
.2500  Y<HSCA)=NM<NSCA) 

DETERMINE  LATEST  TIME  INDEX  OF  NONZERO  POWER  FOR  ALL  ORDERS 

^  CALL  GMAX<NSCAM, YMAX) 

NMA=YMAX 
JP  =  1 

2900  JP=JP+1 

AT=TPU<  JP) 

IF  <AT.LE. 0. 0)  GO  TO  3000 
GO  TO  2900 
3000  JPMAX=JP-1 

WRITE  <  IOOUT,7400) 

WRITE  <IOOUT,7900)  JPMAX 
C 

C***  BEGIN  PULSE  LOOP 
C 

DO  3800  JP=1, JPMAX 
WRITE  <IOOUT,7400) 

TP=TPU<  JP) 

AT=<NMA+4>*DELT 
IF<TP.GT.AT)TP=AT 
IF<TP,LE.DELT)TP=DELT+1 . E-3 
NP-1 . 001+TP7DELT 
NMAXaNMA+NP 

IF<  NMAX . GT . NDIM  )NMAX=NDIM 
HP=NMAX-NMA 
TP=<NP-1  )-»DELT 
TMAX»<NMAX-1  )*DELT 
WRITE  <IOOUT,8100)  JP,TP 
WRITE  <IOOUT,8200)  JP,TMAX 
IF<TP .LE . 0 .  )GO  TO  3999 
DO  3400  NSCA=1,NSCAM 
HMS=NM<  NSCA ) 

NMSI=NMS-} 

C 

CfH.*  NORMALIZE  RETURN  POWER  BY  DIVIDING  CUMULATIVE  POWER  BY  CUMULATIVE 
C***  NUMBER  OF  PHOTONS 

C 

DO  3200  N=>1,NMS1 

320  0  EN<  NSCA , N )=EN<  NSCA , N  )/ENC<  NSCA ) 

C 

C*f*  PERFORM  SQUARE  SOURCE  PULSE  CONVOLUTION  WITH  PROBABILITIES 
Cff*  PER  UNIT  TIME 
C 

CALL  CONV<NP,NMS, NMAX, NSCA) 

3400  CONTINUE 

DO  3500  N>1,NMAX 
V<N)=0, 0 

DO  3500  NSCA>1,NSCAM 
3500  Y<N)«Y<N>+EN<NSCA,N> 

XN=-DELT 

DO  3600  Nat, NMAX 


6AS07C ; u 
BAS 07 020 
BAS0703'. 
BAS07040 
BAS07050 
BAS 07060 
BAS0707C 
BAS 07 COO 
BAS07090 
BAS  071 00 
BAS  071 1 0 
BAS07120 
BASu7 130 
BAS071 40 
BAS07 1 50 
BAS07160 
BAS07170 
BAS07160 
BAS07190 
BAS  072 00 
BAS0721 0 
BAS07220 
BAS07230 
BAS07240 
BAS07230 
BAS07260 
BASC7270 
BAS072B0 
BAS0729U 
BAS 073 00 
BAS0731 0 
BAS 07320 
BAS 07330 
BASC7340 
BAS07350 
BAS07360 
BAS07370 
BAS07380 
BAS07390 
BAS07400 
BAS0741 0 
BAS07420 
BAS07430 
3AS07440 
BAS07450 
BAS07460 
BAS 07470 
BAS07-'30 
BAS07490 
BAS 075 00 
BAS0751 0 
BAS 07520 
BAS07530 
BAS07540 
BAS 07550 
BAS07560 
BAS07570 
BAS07580 
BAS07590 
BAS07600 
6AS0761 0 
BAS07620 
BAS 07630 
BAS07640 
BAS 07650 
BAS07660 
BAS07670 
BAS07680 
BASC7690 
BAS07700 
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?<N=XN+DtLT 
.3600  X<N)=XN 

C***  OUTPUT  TIME-DEPENDENT  RESULTS 

WRITE  < IOOUT>8300> 

WRITE  <  IOOUT,8400) 

WRITE< 100UT,8500>< 10R< NS > , NS«1 , HSCAM > 

WRITE< IOOUT,8501  ) 

C  THE  FOLLOWING  STATEMENTS  SHOULD  BE  UNCOMMENTED  IF  OUTPUT  TO 

C  H  USER-DEFINED  PLOT  FILE  < NPLOTU >  IS  DESIRED. 

C  NMAX  =  NUMBER  OF  TIME  BOXES  USED  FOR  TIME-DEPENDENT  DATA 

C  JP  =  INDEX  D^  INPUT  PULSE 

C  N5CAM  -  1  +  HIGHEST  SIGNIFICANT  ORDER  OF  SCATTERING 

C  X<  >  =  ARRAV  OF  TIME  VALUES  FOR  EACH  TIME  BOX 

C  Y<  )  «  ARRAV  OF  OBSERVED  TIME-DEPENDENT  TOTAL  POWER 

C  EN<L,  >=  ARRAV  OF  OBSERVED  TIME-DEPENDENT  POWER  FOR  ORDER  L+1 

C 

C  IF<Ii.LT.N1>  GO  TO  9777 

C  WRITE< NPLOTU, 9444)  NMAX, JP, NSCAM 
C9444  F0RMAT<3< 13, IX)) 

C  WRITE<NPL0TU,9222)<X<LLL),LLL-1 ,NMAX) 

C  WRITE<  NPLOTU, 9222 )<  VC  LLL ), LLL-1 , NMAX ) 

C  DO  9666  LLL=1, NSCAM 

C  WRITEC  NPLOTU, 9222 )<  ENC  LLL, LLX ),LLXal , NMAX ) 

C9666  CONTINUE 
C^7<'7  CONTINUE 

DO  37u0  N=1 , NMAX 

WRITE  <100UT,8600)  X< N >, V< N ),< EHCHSCA, N >, NSCA«1 , NSCAM ) 

^3700  CONTINUE 

C***  RELOAD  PARTIAL  RUN  RESULTS  FOR  CONVOLUTION  WITH  NEXT  PULSE 

C 

DO  370t  N3-1, NSCAM 
READCKSTOR )ENC<NS> 

DO  3701  II»1,NTMAX 
READC  KSTOR )EN<  NS , 1 1 ) 

3701  CONTINUE 

REWIND  KSTOR 
.3800  CONTINUE 

C***  END  PULSE  LOOP 
C 

1000  CONTINUE 


L 

C*m*  END  OU 
C 

777  RETURN 


END  OUTER  PHOTON  LOOP? 


e***  ERROR  RETURN  MESSAGES 

^3999  CONTINUE 

WRITEC IOOUT,8700>NTMAX 
RETURN 

4000  CONTINUE 

WRITEC IOOUT,8800> 
RETURN 

4001  CONTINUE 

WRITEC IOOUT,9000> 
RETURN 

4002  CONTINUE 

WRITEC IOOUT,9001  ) 
RETURN 

4003  CONTINUE 

WRITEC IOOUT,9002> 
RETURN 

4004  CONTINUE 


BAS0771 0 
BAf  07720 
BAS07730 
BAS07740 
BAS0775u 
BAS07760 
BAS07770 
BAS07780 
BAS07790 
BAS07800 
BAS0781 0 
BAS07620 
BAS07S50 
BAS0784  0 
BAS07S5U 
BAS 07860 
BAS07S70 
BAS078S0 
BAS07S9U 
BAS07900 
BAS0791 0 
BAS07920 
BAS07930 
BAS07940 
BAS07950 
BAS07960 
BAS07970 
BAS07980 
BAS07990 
BASOSOOO 
BAS0801 0 
BAS 08 020 
BAS08030 
BAS 08 040 
BAS08050 
BAS OS 060 
BA308070 
8AS08080 
BAS08090 
BAS081 00 
BAS081 1 0 
BAS081 20 
BAS  08130 
BAS 081 40 
BASOStSO 
BAS08160 
£.'^80817  0 
BAS081S0 
BAS0S190 
BAS 082 00 
BAS082t  0 
BAS 08220 
BAS0S230 
BAS03240 
BAS08250 
BAS08260 
BAS08270 
BAS08280 
BAS08290 
BAS 083 00 
BAS0831 0 
BAS0d320 
BAS08330 
BAS09340 
BAS08350 
BAS 08360 
BAS08370 
BAS083d0 
BAS08390 
BAS 08400 


( 
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URITE< 100UT,9005  > 

RETURN 

4005  CONTINUE 

WRITE< IOOUT,9006> 

RETURN 

C  in  41  *  « I*  P  0  R  N  ^  T  S 
42  0  0  FORMAT  <7F1  0.5'; 

4400  FORMAT  <71 1 0  > 

4500  FORMAT  < 1 1 0, 2Fi 0 . 5, II 0 ) 

4600  FORMAT  <SE15.10) 

4700  FORMAT  <1H  ,  34X,  51  <  1  H-»  )  i 
4800  FORMAT  <1H  , 34X, 1 H* , 49X, 1 H* ) 


BAS  08 4 ■ 
BASOftC 
BAS  084 3  •) 
BAS0S44  j 
BA?  C  V5'' 
UAS  L -“O' 
WAS  C'H4  <■  u 
BAS0S480 
&AS08490 
BAS08500 
BAS  0851  0 
BAS0852n 


4900  FORMAT  <1H  , 34X , 1 H-* , 9X, 3 1 HMONTE  CARLO  MULTIPLE  SCATTER ING , 9X , i Hf  )  BAS08530 


5000  FORMAT  <1H  ,  34X ,  1  H* ,  1  6X ,  1 8HAER0S0L  SCATTERING ,  1  5X ,  1  H-*  >  BAS0S540 

5100  FORMAT  < 1  HO , 48X , 23HPARAMETERS  FOR  THIS  RUN >  BAS0S550 

5200  FORMAT< 1H0,46X,28HUSER  SUPPLIED  PHASE  FUNCTI0N>  BAS08560 

5201  FORMAT< 1H0,43X,34HMARITIME  ARCTIC,  VIS«»0.1  TO  2.0  KM >  BAS08570 

5202  FORMAT< 1H0,47X,26HMARIT1ME  POLAR,  VIS=0.2  KM)  BAS0&580 

5203  FORMAT< 1H0,47X,26HMARITIME  POLAR,  VIS=2.0  KM)  BAS0S590 

5204  FORMAT< 1HO,42X,36HCONT1NENTAL  POLAR,  V1S=0.2  TO  2.5  KM)  BAS08600 

5205  FORMAT< 1H0,52X, 16HWHITE  PHOSPHORUS)  BAS03610 

5206  FORMAT< 1H0,52X, 16HHEXACHL0R0ETHANE)  BAS08620 

5207  F0RMAT< 1HO,57X,7HFOG  OIL)  BAS08630 

520.9  FORMAT<  1H0,45X,31HDUST  <  MODERATE  AEROSOL  LOADING))  BAS08640 

5209  FORMAT< 1H0,46X,28HDUST  <HEAVY  AEROSOL  LOADING))  BAS08650 

5210  FORMAT< 1H0,43X,34HMAR1TIME  MODEL  B,  V1S=5  KM,  RH=95X >  BAS08660 

5211  FORMAT< 1H0,43X,35HMARITIME  MODEL  B,  V1S=10  KM,  RH=90X)  8AS03670 

5212  FORMAT< 1H0,43X,35HMARITIME  MODEL  B,  V1S=50  KM,  RH=50X)  BASOCSSO 

5500  FORMAT  < 1  HO , 46X , 27HUSER  SUPPLIED  AEROSOL  MODEL)  BAS0&690 

5600  FORMAT  <1H  , 36X , 1 1 HWAVELENGTH= , F6 . 3 , 1 6H  MICROMETERS  BAS08700 

1  7HAL8ED0=,F5.3)  8AS08710 

5601  FORMAT< 1HO,47X,25HELL1PSOIDAL  AEROSOL  CLOUD)  BAS0872C 

5602  FORMAT<1H  , 41 X, 36HC00RDINATE  ORIGIN  AT  CENTER  OF  CLOUD)  8ASOS730 

5603  F0RMAT<1H  , 38X, 42HZ-AXIS  VERTICAL,  X-AXIS  EAST,  Y-AXIS  NORTH)  BAS08740 

5700  FORMAT  <IH  , 36X, 31HAER0S0L  EXTINCTION  COEFFICIENT*,  BAS08750 

1  El  0.4,7H  KM4.*-1  )  8AS08760 

5701  FORMAT< 1  HO, 51 X, 17HS0URCE  PARAMETERS)  BAS08770 

5702  FORMAT<1H  , 36X , 27HSOURCE  XYZ  COORDINATES< KM )*, 3< F8 . 4 , 1 X )  )  BAS08780 

5703  FORMAT<1H  , 36X , 27HS0URCE  APERTURE  RADIUS< MM )=, F7 . 3 >  BAS0S790 

5704  FORMAT<1H  , 36X , 26HS0URCE  AXIS  POLAR  ANGLE  =,F7,3,8H  DEGREES)  BAS08800 

5705  FORMAT<1H  , 36X , 26HS0URCE  AXIS  AZIMUTH  ANGLE* , F7 . 3 , 8H  DEGREES)  BAS08810 

5706  FORMAT<1H  , 36X, 26HS0URCE  BEAM  SPREAD  ANGLE  =,E10.4,8H  RADIANS)  BAS08320 

5900  FORMAT  <  1  HO ,  5 OX ,  1 9HDETECT0R  PARAMETERS)  F;AS0S830 

6000  FORMAT  <1H  ,35X,29H  CONE  OF  VIEW  HALF-ANGLE  =,F7,3,  BAS08840 

1  8H  DEGREES)  BAS08850 

6100  FORMAT  <1H  ,35X,29H  DETECTOR  APERTURE  RADIUS  =,F7,3,  BAS08860 

1  3H  CM)  BAS0SS70 

6201  FORMAT<1H  , 36X, 29HDETECT0R  XYZ  COORDINATES< KM  )*, 3< F8 , 4 , 1 X  )  >  BAS08390 

6400  FORMAT  <1H  , 36X, 28HDETECT0R  AXIS  POLAR  ANGLE  ■,F7.3,  BAS0889? 

1  8H  DEGREES)  BAS03900 

6500  FORMAT  <1H  ,  36X ,  28HDETECT0R  AXIS  AZIMUTH  ANGLE*, F7. 3,  BAS0391Ci 

1  8H  DEGREES)  BAS 03920 

6501  FORMAT< 1HO,47X,23HGROUND  PLANE  PARAMETERS, /, 4 OX , 38H ISOTROPIC  REFLEBAS03930 

♦CTION  FROM  GROUND  PLANE)  BAS03940 

6502  FORMAT<1H  ,  36X , 33HGR0UND  PLANE  Z-COORDIHATE  ZC<  KM  >*,  F7 . 3,  X,  BAS0395'j 

*37X,33HGR0UND  PLANE  ALBEDO,  AL8G,  *,F7.3)  BAS03960 

6800  FORMAT  < 1  HO, 34X, 51< 1 H* >  )  BASC8970 

6900  FORMAT  < I  HO, 5 1 X, 1 6HCL0UD  PARAMETERS)  BAS08980 

7000  FORMAT<1H  , 31 X, 43HELLIPS0ID  PRINCIPAL  XYZ  HALF-AXES< KM )  =,  BAS08990 

■•3<F8.4,  1X)>  BAS09000 

7100  FORMAT  <1H  , 31 X, 43HEULER  ANGLES  THE,PHE,PSE  OF  ELLIPSOID< DEG >* ,  BAS09010 

•3<F8.4,1X))  BAS09020 

7200  FORMAT  <1H  , 31 X , 43H0PT ICAL  DEPTHS  ALONG  ELLIPSOID  XYZ  AXES  =,  BAS09030 

*3<F8.4,1X)>  BAS09040 

7400  FORMAT  <1H0,100X>  BAS09050 

7500  FORMAT  < 1  HO, 32X, 53HSTEADY  STATE  POWER  TO  DETECTOR,  FOR  UNIT  SOURCEBAS09060 
«>  POWER)  BAS09070 

7600  FORMAT  < 1  HO, 37X, 5H0RDER, 3X, 1 8HSTEADY  STATE  POWER, 3X,  BAS0S080 

1  17HNUMBER  OF  PHOTONS)  BAS09090 

7700  FORMAT  <1H  , 39X, 12, 8X, El  0 , 5, 8X, El  2 ,6 )  BAS09100 


=,F7,3, 


BAS0S540 
BAS0S550 
BAS08560 
BAS08570 
BAS 08580 
BaS0'S590 
BAS08600 
BAS0361 0 
BAS  08620 
BAS08630 
BAS08640 
BAS08650 
BAS08660 
BAS  03670 
BAS0r6S0 
BAS0&690 
BAS08700 
BAS0871 0 
BAS0872C 
BASOS730 
BAS08740 
BAS08750 
8AS08760 
BAS08770 
BAS  08780 
BAS0S790 
BAS08800 
BAS0881 0 
BAS08320 
BAS 0883 0 
BAS08840 
BAS08850 
BAS 08860 
BAS0SS70 
BAS  083 9  0 
BAS 0889? 
BAS03900 
BAS 0391 0 
BAS  03920 
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7701  FORMAT  <1H  , 37X, 5HT0TAL, 7X, El  0 . 5 >  BAS091i0 

7900  FORMAT  < 1  HO, 32X , 23HP0WER  INTO  DETECTOR  F0R,I2,6H  PULSE  BAS09120 

1  23H(S>  OF  DIFFERENT  LENGTH >  BAS09130 

8100  FORMAT  < 1 H 0 , 37X, 1 2HPULSE  NUMBER, 12, 12H  HAS  LENGTH  ,  BAS09140 

1  El  0.4, 13H  MICROSECONDS)  BAS091SO 

8200  FORM«1  <1H  , 23X , 34HDETECTOR  RESPONSE  CUTOFF  TIME  FOR  BAS09160 

1  12HPULSE  NUMBER, 12, 4N  IS  , El  0.4,  BAS09170 

2  13H  MICROSECONDS)  BAS09180 

8300  FORMAT  < 1  HO, 25X , 68HDETECT0R  RESPONSE,  POWER  AS  A  FUNCTION  OF  T IME, BAS091 90 

♦  FOR  UNIT  PULSE  POWER)  8AS09200 

8400  FORMAT  < 1  HO, 55X , 21 HPOWER  FROM  EACH  0RDER71 4X, 5HT0TAL  )  BAS09210 

8500  FORMAT  <1H  , 3X, 4HTIME, 6X, 5HP0WER, 2X, 1 0< 5X, 12, 4X  )  )  BAS09220 

8501  FORMAT<1H  ,130<1H-))  BAS09230 

8600  FORMAT  < 1 2< E 1 0 . 4 , 1 X  )  )  8AS09240 

8700  F0RMAT< 1H0,6HNTMAX=, 13,80H  SHOULD  BE  DECREASED  TO  46.  IT  IS  TOO  LABAS09250 

*RGE  TO  ALLOW  CONVOLUTION  WITH  YOUR  PULSE)  BAS 09260 

8800  FORMAT< lHO,97HyOUR  INCIDENT  PHOTONS  NEVER  INTERSECT  THE  CLOUD  OR  TBAS0927U 
♦HE  GROUND.  CHECK  YOUR  INPUT  SOURCE  PARAMETERS)  BAS09280 

9000  FORMAT< 1H0,72HTHE  DETECTOR  LOOKS  ABOVE  THE  CLOUD.  CHECK  YOUR  iHPUTBAS09290 

♦  DETECTOR  PARAMETERS)  BAS09300 

9001  FORMAT< 1HO,65HYOUk  GROUND  PLANE  IS  ENTIRELY  ABOVE  YOUR  CLOUD.  CHECBAS0931 0 

♦K  YOUR  INPUTS)  BAS09320 

9002  FORMAT< 1H0,76HNEITHER  YOUR  SOURCE  NOR  YOUR  DETECTOR  LOOK  INTO  THE  BAS09330 

♦CLOUD.  CHECK  YOUR  INPUTS)  8AS09340 

9003  FORMAT< 1HO,71HYOUR  SOURCE  WAS  UNDERGROUND.  IT  HAS  BEEN  PUT  AT  THE  BAS09350 

♦  GROUND.  WITH  XS< 3 )= . F6 . 3 , 2HKM  )  BAS09360 

9004  FORMAT< 1H0, 1 14HY0UR  GROUND  PLANE  HAS  TOO  FAR  AWAY  FROM  THE  CLOUD  TBAS09370 
♦0  PRODUCE  GROUND  REFLECTIONS  WITHIN  THE  MAX  TIME  DELAY  ALLOWED BAS09380 

♦  34H  THE  GROUND  PLANE  WAS  MOVED  TO  2G*= ,  F6 . 3 , 2HKM  >  BAS09390 

9005  FORMAT< 1HO,91HGROUND  PLANE  WAS  ABSENT  AND  DETECTOR  DOES  NOT  LOOK  ABAS09400 

♦T  CLOUD.  CHECK  YOUR  DETECTOR  PARAMETERS)  BAS 094 10 

9006  FORMAT< 1H0,79HGR0UND  PLANE  WAS  ABSENT  AND  SOURCE  DOES  NOT  ILLUMINABAS09420 

♦TE  CLOUD.  CHECK  YOUR  INPUTS)  BAS09430 

END  BAS09440 
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ooo  ono  non  ono  ono  onon 


SUBROUTINE  8KUD< JTYPE > 

COMMON  /'CONST/'PI  ,PI2,PIRPD,TM0PI  ,TORRMB.CDEGK 
COMMON/RNDM/  SEED 

COMMON  /M05/V1 , Cl , SI , SA< 3 > . EN< 10, 100>,ENC< 1 0 >, ELMIN, DELD, DTuT, 
+NTMPX,NSCrtM,KMPX,LMAX,LMM1 

COMMON  /BASP0T/U<65),SUM<65i,WVL< 1 6 >, NWVL, ALBED< 16>,BS< 16>, 

+BE< 16>,SINGUV,PF<65>,LLMAX 

C0MM0N/FAHT/'SD<3>,UV,GAMMA,ELD<2),STH,FAC,AL1M,THV,TAU,EU<2>, 

*ALB<2>,2G,DMAX 

COMMON/FWD/AKM , R<  3 , 3 ) , AKSO , XD<  3 ) , ASQ<  3 ), RE<  3 , 3  > , A<  3 ) 
C0MM0N/FGEL/'XA<  3  ),  D,  NSCA 
DIMENSION  SBC<3),SBA<3) 

NSCAP=HSCA+1 

•*  DETERMINE  MONTE  CARLO  BACkUARD  TRAVERSE  ANGLES  THETA  < AT > 

AND  PHI  <eTj  INSIDE  DETECTOR  CONE, 

BT=TWOPI*RAND  <  SEED) 

AT=THV>*RAND  <  SEED> 

IFCAT.LE. 1 .E-30>  AT=0, 

IF<;  S7  ,  Lt .  i  .  E-30  >  BT-u. 

V  =  SIN<;  AT  ) 

U23=C0S^  AT  > 

•*  ROTATE  BACKWARD  TRAVERSE  VECTOR  INTO  STANDARD  FRAME  OF  REFERENCE. 
CALL  R0TAT( AT, BT, R, SBC  ) 

•*  DETERMINE  BIASING  DISTANCES  FOR  BACKWARD  TRAVERSE. 

CALL  ELM<XO,SBC,EL J 

DETERMINE  STATISTICAL  WEIGHT  REX  OF  BACKWARD  TRAVERSE. 

REX=  1  .  -EXP<  -GAMMA‘*><  EL<  2  >-EL<  1)  >  ) 

REXRN=REX*RAND<  SEED  > 

IF<< 1 .-REXRN>.LE. 1 .E-7>  GO  TO  15 

DETERMINE  RANDOM  DISTANCE  FOR  BIASED  BACKWARD  TRAVERSE. 

ELBC  =  -ALOG<  1  . -REXRN  )/'GAMMA+EL<  1  ) 

CT=0. 

DO  4  K=1 ,3 

SBAC  K  )=XD<  K  )-XA<  K  )+SBC<  K  )>»ELBC 

4  CT=CT+SBA< K >*f2 
IF<CT,LE, 1 .E-30)  CT=0. 

ELAB=SQRT<CT) 

IF<ELAB.LT.ALIM)GO  TO  15 

<*  DETERMINE  TIME  BOX  INDEX  NT  FOR  THE  COMPLETE  BACKWARD  TRAVERSE, 

NT=1  .  +<  DTOT+ELAB+ELBC-ELMIN  )/'DELD 

IF<NT.LT. 0;  GO  TO  15 

IF<NT.EQ. 0>  NT-1 

IF<  NT . GT . NTMAX  >RETURN 

U1-0  . 

U2-0. 

DO  5  K-1 ,3 

sba':k>=sba<k)/elab 

U1-U1+SA<K)*SBA<K) 

5  U2»U2-SBA<K)f8BC<K) 

6  CALL  FIND<U2,PF2) 

IF<  JTYPE.EQ.2)G0  TO  9 
CALL  FIND<U1 ,PF1 > 

GO  TO  10 
9  CONTINUE 

CALL  ELM<XA,SBA,EL) 

ELA8=ELAB-EL<  1  > 

PFi=1 . 

1  0  DOM«FAC*ALB<  1  >>*STH*REX*V'*U23>»'PF  1  >»PF2*EXP<  -CAMMA'*ELAB  >,^CT 


BKIJOOO;  . 
BKWOOC':-’ 
BKWCCCSi 
BkWOOU'I 
BkWOOOSO 
p  ■  r: 
OKLL  C  CTO 
BKWOOOSC 
BkWCiOOSCj 
BKUI0C1  0  0 
BKU001 1 0 
BKWOOI 20 
BKWOCM  3  0 
BKWOO’ 40 
BKw  0  0 i D  0 
BkU'  P  0  1  6  0 
Bkui  0  0  i  70 
bKW  0  018  0 
BKWOOI 90 
BKW00200 
BKWU021 0 
BKW00220 
BKW0023D 
BKW 00240 
SKWOOSsO 
BKW 00260 
BKW 00270 
BKW 002 80 
BKW 00290 
BKW u 03 00 
BKWu03) 0 
BKW 00320 
BKU0  03.'0 
BKW 0  034  0 
BKW 00350 
BKW 00360 
BKW 00370 
BKW 00380 
BKW  0  039  0 
BKW 004 00 
BKW 004 1 0 
BKW 00420 
BKW 00430 
BKW 00440 
BKW 00450 
BKW 00460 
BKW0  0‘‘.7  0 
BKW  0  0'.  3  0 
BKW 00490 
BKW 005 00 
BKW 0051 0 
BKW 00520 
BKW00530 
BKW 00540 
BKW 005 50 
BKW 00560 
BKW 00570 
BKW C 0580 
BKW00590 
BKW 006 00 
BKW 0061 0 
BKW 00620 
BKW00630 
BKW 006 40 
BKW 00650 
BKW 00660 
BKW 00670 
BKWOnsSO 
BKU 00690 
BKW 007 00 
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Bku)0071  u 
BKW00720 
BKUlf  0730 
BkU00740 
BkUI00750 
BKU00760 


EN<  NSC^P ,  NT  >=EN<;  N3CAP ,  NT  )+DOM 
RETURN 

15  ENC<NSCPP)=EHC<NSCAP>-i  . 
STH=0. 

RETURN 

END 


SUBROUTINE  CONV<  NP , NHS , NMAX, NSCR  > 

C**hi**THIS  SUBROUTINE  CONVOLUTES  A  GIVEN  SEQUENCE  OF  VALUES  EN<NSCA,N>, 
C  N=1,NMS,  WITH  THE  UNIT  SQUARE  FUNCTION  EXTENDING  FROM  TIME=0  TO 

C*****TIME=<NP-1 >*DELT, 

DOUBLE  PRECISION  DBLE, XDBLE< 1 00 > 

COMMON, ■'CONB/'X<  1  00),  Y<  1  00  > 

COMMON  /MOS/VI ,C1 , SI , SA< 3 ) , EH< 1 0 , 1 00>,ENC< 1 0  ), ELMIN, DELD, DTOT, 
+NTMAX,NSCAM,KMAX,LMAX,LMM1 

COMMON  /8ASP0T,^U<65>,SUM<65),UVL<  1  6  ),  NWVL,  ALBED<  16),BS<  16), 

+BE< 16),SINGWV,PF<65),LLMAX 
HMS1=NMS+1 
NMA=NMS+NP-1 
XDBLE':  i  j=0  .  E-00 
DO  100  N=2,NMS 

100  XDBLE<N)=XDBLE<N-1  )+DBLE< EN< NSCA, N-1  )) 

NP1=NP+1 

IF  <NP,LT.NMS)  GO  TO  600 
DO  200  N=1,NMS 

200  y<n)=,'<:dble<n) 

IF  <NP,EQ.NMS)  CO  TO  400 
DO  300  N=NMS 1 , NP 
300  V< N  )=XDBLE< NMS  ) 

400  CONTINUE 

DO  500  N=NP1,NNh 

500  Y<N)=,XDBLE<NMS)-XDBLE<N-NP+1  ) 

GO  TO  1000 
600  CONTINUE 

DO  700  N=l ,NP 
700  Y<N)=XDBLE<N) 

DO  800  N=NP1 ,NMS 
800  Y<N)=XDBLE<N)-XDBLE<N-NP+1 ) 

DO  900  N«=NMS1  ,NMA 
900  Y<N)=XDBLE<NMS)-XDBLE<N-NP+1  ) 

1000  CONTINUE 

IF  <NMA.EQ.NMAX)  GO  TO  1200 
NMA1=NMA+1 
DO  1100  N=NMA1 ,NMAX 
1 100  Y<N)=0.0 

DO  1150  N=1 , NMAX 
1 150  EN<NSCA,N)=Y<N) 

1200  RETURN 
END 


CONOCO  1 0 
CONG  0  02  i' 
CONC003.i 
CON  0  0 04  0 
COHO  Cl 5  0 
CON 00 060 
CON  0  0 07  0 
CON 00 080 
CON 00 090 
CONOOl 00 
CON001 1 0 
CONOOl 20 
CONOOl 30 
CONOOl 40 
CON00150 
COH00160 
CONOOl 70 
CONOOl SO 
CONGO  190 
CON 002 00 
CON  0  021  0 
CON00220 
CON  0  023  0 
CON  0  024  0 
CON 00250 
CON 00260 
CON 00270 
CON002S0 
CON 00290 
CON 003 00 
CON0031 0 
CON 00320 
CON00330 
CON 00340 
CON  0  035  0 
CON 00360 
CON  0  037  0 
CON00380 
CON  0  039  0 
CON004no 
CON0041 0 
CON  0  042  0 
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ELHuOO) 0 
ELM00020 
ELM  0  0 03  0 
ELM 00 040 
ELM00050 
ELM00060 
ELMOOOf'O 
ELM00080 
ELM00090 
ELM001 00 
ELM001 1 0 
ELM001 20 
ELM00130 
ELMO  01 40 
ELMOOi 50 
ELM00160 
ELMOOI 70 
ELM00130 
ELMO  01 90 
ELM00200 
ELM0021 0 
ELM00220 
ELM00230 
ELMO 0240 
ELM00250 
ELM00260 
ELM 00270 
ELM 00260 
ELM 00290 
ELM 003 00 
ELM0031 0 
ELM00320 
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FINOOOl u 
FIN0002C 
FIN00030 
FINOOO-JO 
FINOOO-SO 
FIN00060 
F I H  0  0  0  7  0 
FINOOOSO 
FIN00090 
FINOOl 00 
FIN001 1 0 
FIN00120 
FIN00I30 
FIN00140 
FIH001 50 
F I N  0  0 1  6  0 
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SUBROUTINE  FURDc  SCA,  DOM,  ELAO 

COMMON/'CONST/PI  ,PI2,PIRAD,TW0PI,T0RRMB,C0EGK 
C0t1M0N,'FGEL,-’XA<3),D,NSCA 

C0MMCiN,'FWD,'AKM,R<3,3),AKSQ,XD<3),ASQ<3>,RE<3,3),A<3> 
COMMON/RNDM/  SEED 
DIMENSION  SCA<3> 

P3i  =  TulOPI“fRAND  <  SEED) 

TH=PI2 

CALL  kOTAT< TH, PSI , R, SCA > 

ANR=RAND<SEED) 

IFc ANR . LE . 1 . E-30  )  ANR=0. 

RHO=AKM*SORT< ANR  > 

ELSO=0 . 

DO  1  K:*  t  ,  3 

SCAC  K  )=XD<  K  )-XA<  K  )+SCA<  K  )-*RHO 
ELSO=ELSQ+SCA<  K ^**2 
IF<  tLSO  .  LE  .  1  .  E-jO  .>  EL3Q=i.E-30 
ELAC=SQRT<EL8GI  ) 

DO  3  K=1 , 3 

SCA<  K  )=SCA<  K  JXELAC 

DOM=AKSQ/''<  4  .  •fELSQ  ) 

RETURN 

END 


FUROOOi 0 
FhlROOOao 
FUR CO 030 
FUR00040 
FUROOOSO 
FUR 00 060 
FUR00070 
FUROOOSO 
FUROOOSO 
FUROOl 00 
FUR001 1 0 
FUR00120 
FUR00130 
FUR00140 
FUR00150 
FUR00160 
FUROOl 70 
FUR00180 
FUROOl SO 
FUR00200 
FUR0021 0 
FUR00220 
FUR00230 


71 


>0000000 


SUBROUTINE  GAS(JTYPE> 

THIS  SUBROUTINE  DETERMINES  A  RANDOMLY-SELECTED  SCATTERING 
DIRECTION  USED  IN  PHOTON  TRAVERSES  WITHIN  THE  ELLIPSOIDAL 
AEROSOL  CLOUD.  JTYPE«1  SIGNIFIES  THAT  THE  SCATTERING  EVENT  AT 
WHICH  THIS  ANGLE  IS  SELECTED  IS  WITHIN  THE  AEROSOL  CLOUD. 
JTYPE=2  SIGNIFIES  THAT  THE  SCATTERING  EVENT  IS  ON  THE  GROUND 
PLANE , 

COMMON.^ALL/'AT,  BT,  CT,  BLIM 

COMMON/CONST/’PI ,  P12,  PIRAD,  TUOPI ,  TORRMB,  CDEGK 

COMMON  /MOS/Vl , C 1 , S 1 , SA<  3  ) . EH<  I  0 > 1 00),ENC<  I  0  > . ELM  I N , DELD . DTOT , 
+NTMAX,NSCAM,KMAX,LMAX,LMM1 

COMMON  XBASP0TXU<65),SUM<65>,WVL<16>,HWVL,AL.BEDC  16),BS<  16>, 
+BE< 16>,SINGWV,PF<65),LLMAX 
COMMONXRNDM/  SEED 
COMMDN,'FGELXXA<  3  >,  D,  NSCA 
AT=RAND  <  SEED) 

Ik!  AT  .  LE  .  1  .  E-3  0  ;  AT  =  0. 

IF<  JTYPE.EQ. 1 >G0  TO  1 

SAC  3  >=i . -AT 

ARG= 1  . -S A<  3  >**5 

IFC ARG , LT . 1  . E-30  )  hRG=0. 

BT=TWOPI*RAHD  <  SEED) 

IFCBT.LE. 1 .E-30)  BT=0, 

V1=S0RT<ARG) 

ci=cos<;bt) 

S1=SIN<BT) 

SAC  1  )=V1*C1 
SAC  2  >=Vt  i>Sl 
RETURN 

I  CALL  USCACAT.BT) 

CT=TWOPI*RAND  C  SEED) 

IFCCT.LE.  1  ,E-30)  CT=<1. 

ARG=1  .  -BT*'*2 
IFCARG.LT. f ,E-30)  ARG»0, 

V»SQRTC ARC) 

C=COSCCT) 

S=SINCCT) 

SAC  1  )«=eT*SAC  1  )+V'»CC*C1>i>SAC3>-S*S1  ) 

SAC  2  )=BTt*SAC  2  )+V*C  C*S1  ♦SAC  3  )+S'*>C1  ) 

SAC  3  )=BT*SAC  3  )-Vi<C'*'V  1 
AT=SAC  1  )*>*2+SAC2)*'c2 
IFCAT.LT. 1 .E-1 0)GO  TO  3 
V1=SQRTC AT) 

C1=SAC  1  )/’V1 
S1=SAC2)/’V1 
RETURN 
I  C1=C 
S1=S 
V1=0. 

SAC  1  )«0, 

3AC2)=0, 

BT=SAC3> 

SAC3)=1  . 

IFCBT.LT. 0.  )SAC3)*-1 . 

RETURN 

END 


)SAC3)*-1 


GASOOOf  0 
GAS00020 
GAS 00 030 
GAS 00 040 
GASOuOSCi 
GAS00060 
GAS 00 070 
GASOOCSO 
GASOuOSO 
GASOOI 00 
GAS001 1 0 
GAS00120 
GAS00130 
GAS00140 
GAS00150 
GAS00160 
GASOOI 70 
GAS00180 
GASOOI 90 
GAS 002 00 
GAS0021 0 
CAS0C220 
GASuu230 
GAS 00240 
GAS0u250 
GAS 00260 
GAS00270 
GAS00280 
GAS00290 
GAS00300 
GAS003t  0 
GAS 00320 
GAS00330 
GAS00340 
GAS00350 
CAS00360 
GAS00370 
GAS00380 
GAS00390 
GAS 004 00 
GAS 0041 0 
GAS00420 
GAS 00430 
CAS 00440 
GAS00450 
GAS00460 
GAS0C470 
GAS 004 80 
GaS00490 
GAS00500 
GASOOSI 0 
GAS 00520 
GAS00530 
GAS00540 
GAS00550 
GAS00560 
GAS00570 
GAS00580 
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SUBROUTINE  GMhX< IMAX, VMAX > 

C 

C***  THIS  SUBROUTINE  DETERMINES  THE  MAXIMUM  VALUE  VMAX  OF  AN  INPUT 
C*»*  ARRAY  Y<  )  OF  DIMENSION  IMAX. 

C 

COMMON/'CONB/'X<  1  00).  Y<  1  00  > 

1  =  0 

YMAX=Y< 1 > 
i  I=I+J 

IF< I .EQ. IMAX)RETURN 
T=Y< 1+1 )-YMAX 
IF<T.GT.0. >VMAX=V<I  +  i  ) 

GO  TO  1 
END 


GHAOOul 0 
GMA00020 
GMA''  0  030 
GMAu  0040 
GMA00050 
GMA00060 
CnA00070 
GMAOOOSO 
GNAOOOSO 
GMAD01 00 
GMA001 1 0 
GMA001 20 
GMA001 30 
GMA00140 
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SUBROUTINE  MATRXt:  TH,  PH ,  S .  R  ) 

C 

C-****  THIS  SUBROUTINE  GENERATES  UNIT  VECTOR  S<  >  ANO  ROTATION  MATRIX 
C***  R<  )  FOR  A  SET  OF  INPUT  POLAR  ANGLES  i:TH.PH>, 

C***  THE  ROTATION  MATRIX  R<  >  ROTATES  A  VECTOR  DEFINED  RELATIVE  TO  THE 
C***  <TH,PH>  DIRECTION  INTO  THE  STANDARD  SYSTEM  OF  COORDINATES, 

THE  UNIT  VECTOR  S<  )  POINTS  IN  THE  <TH,PH>  DIRECTION  IN  THE 
C***  STANDARD  SYSTEM  OF  COORDINATES. 

C 

COMMON  /CONSTr^PI ,  PI2.  PIRAD,  TWOPI  >  TORRMB,  CDEGX 
DIMENSION  S<3),R<3,3; 

AT»PIRAD*TH 
BT=PIRAD*PH 
IF<AT.LE. 1 .E-30)  AT=0. 

IF< BT . LE . 1 . E-30  ;  BT=0. 

V1=S1N<AT> 

Cl  =CCiS<  BT  ) 

S1=SIN<BT> 

S( 1 JsvI^CI 
S<  2  >=V1 *S1 
S<  3  >=COS<  AT  i 
R< 1 , 1  >»C1 ♦S<  3  > 

R<  1 ,2)=S1*S<3) 

R<  1 ,3>=-V1 
R<2, 1 >=-S1 
R<2,2)=C1 
R<2,3>=0. 

DO  1  K=1,3 
t  R<3,K>=S<K) 

RETURN 

END 


MATOOul 0 
MAT0002'' 
MAT 00 030 
MAT  0  0040 
MAT00050 
MAT  0  0 06  0 
MATC007CI 
MAT00080 
MAT  OOOSO 
MAT  00100 
MAT001 1 0 
MAT00120 
MAT  00130 
MAT001 40 
MAT001 50 
MAT001 bO 
MA I  00170 
MATOO1S0 
MATOOISO 
MAT  00200 
MAT  00210 
MAT00220 
MAT00230 
MAT00240 
MAT00250 
MAT0026C 
MAT00270 
MAT00280 
MAT00290 
MAT  003 0  0 
MaT0031 0 
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SUBROUTINE  ROT(^T<  TH,  PH,  R.  S  ) 
DIMENSION  R<3.3>.X<3>,8<3> 
IFCTH.LE.t  .E-30)  TH=0. 
IFCPH.LE. 1 .E-30>  PH=0. 
V=SIN< TH) 

X<  1 >«V*COS<PH> 
X<2>=V*SIN<PHi 
X<3>=C0S<TH) 

DO  1 
S<  v»)*0. 

DO  1  K=1,3 

S<  J>=«S<  J>fR<K,  J>*X<K> 

RETURN 

END 


ROTOOOJ  0 
ROT00020 
ROT  0(1 030 
ROTOi 040 
ROT00050 
ROT00060 
ROT00070 
ROT00080 
ROTOOoSO 
ROT001 00 
ROT001 1 0 
ROT00120 
ROT00130 
ROT  00140 


SUBROUTINE  3H00Z<NSCA, NO i 

C****.#THIS  SUBROUTINE  DETERMINES  'NO',  THAT  VALUE  OF  I  BEYOND  WHICH  ALL 
C****h<Y<  I  >  IN  A  SEQUENCE  ARE  ZERO. 

COMMON  ^M05/V1 ,C1 ,S1 ,SA<  3),EN< 1 0, t 00>,ENC< 1 0 ELMIN, DELD, DTOT, 
+NTMAX , NSCAM ■ KMAX , LMAX . LMM \ 

COMMON  XBASP0T/U<65>,SUM<65>,WVL<  1  6  >,HUIVL,  ALBED<  16>,BS<  16>, 

+BE< 16>,SINGUV,PF<65),LLMAX 
I=NTMAX+! 

100  1=1-1 

IF< I .EQ. 0>GO  TO  200 
yi=EN(NSCH, I  ) 

IF  <YI .GT. 0.0)  GO  TO  200 
GO  TO  100 
200  NO=I 
RETURN 
END 


SM00001 0 
SM000020 
SM000030 
SM000040 
SM000050 
SM000060 
SM000070 
SM000080 
Shu 00 090 
SMOOOl 00 
3M0001 1 0 
SM000120 
3h000130 
SMOOOl 40 
SMOOOl 50 
SMOOOIbO 
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SUBkOUTIHE  stark 5S) 

•*  THIS  SUBROUTINE  INITIALIZES  PHOTON  LAUNCH  DIRECTION  AND  CALCULATE 
*■*  DIRECT  BEAK  <  ZEROTH  ORDER)  CONTRIBUTIONS  TO  RECEIVED  POWER, 

COMMON/'ALL/'AT ,  BT ,  CT ,  BL I H 
COMMON/CONB/'X<  1  00), Y<  1  00) 

C0MH0N/FWD/'AKM,R<3,3),  AKSQ,XD<3>,ASQ<3>,RE<3,3),A<3) 

COMKON/H I T/UDS , THSP , RS<  3 , 3 ) , XS<  3 ) , OSA ,  XV<  3 ) 

COMKON,''FGELXXA<  3  ) ,  D ,  NSCA 

C0MM0N/FAHT/'SD<3),UV,GAHMA,ELD<2),STH,FAC,  ALIM,THV,TAU,EL<2), 
*ALB<2),2G,DKAX 
COMMON, ■’RNDM/  SEED 

COMMON  XMOS/'VI  ,  C 1  ,  S i  ,  SA<  3  ) , EH<  1  0,  lOO.ENCC  1  0  ),  ELMIN,  DELD,  DTOT, 
+HTMAX,HSCAM,KMAX,LMAX,LMM1 

COMMON  /'BASP0T/'U<65),SUM<65),WVL<  16).NWVL,  ALBED<  16>,BS<  16), 

+  BE<  16),S1NGUIV,PF<65),LLMAX 
COMMON  /COHSTXPl , PI2, PIRAD,TWOPI , TORRMB, CDEGK 
DIMENSION  SS<3) 

**  GENERATE  RANDOM  THETA  CAT)  AND  PHI  <BT)  PHOTON  LAUNCH  ANGLES 
CONFINED  WITHIN  SOURCE  CONE, 

ANR=RAN0<SEE0) 

IF< hNR . LE . 1 . E-30 )  ANR=0. 

AT*THSP*SaRT<AHR) 

BT=TU0PI*RAND  <  SEED) 

**  ROTATE  LAUNCH  VECTOR  SAC)  INTO  STANDARD  FRAME  OF  REFERENCE. 

CALL  ROTATCAT,BT,RS,SA) 

DETERMINE  HORIZONTAL  COMPONENT  CT  OF  LAUNCH  VECTOR  AND  BRANCH 
TO  VERTICAL  TREATMENT  C  WHICH  INCLUDES  GROUND  PLANE)  IF  THIS 
COMPONENT  IS  VERY  SMALL, 

CT=SAC  1  )‘*'*2+SA<  2 
IFCCT.LE. 1 ,E-24)G0  TO  1 
V1=SQRT<CT) 

C1*SA<  i  )/'V1 
S1=SA<2)/'V1 
CO  TO  2 

DEFINE  VERTICAL  UNIT  VECTOR 

1  V1=0. 

CT=SA<  3) 

SA<3)=1  . 

IFCCCT.LT, 0,  ).AND.CALBC2),GT,0.  ))  SA<3>»-1 . 

C1=1  , 

SI  =0  , 

SAC  1  )=0. 

SA<2)»0. 

**  INITIALIZE  TOTAL  TRAVERSE  DISTANCE  DTOT  AND  STATISTICAL 
STRENGTH  STH. 

2  DTOT-O, 

STH*1 . 

BT-0. 

IFC AT.LE. 1 .E-30)  GO  TO  1 1 
DAA=DSA/'COS<  AT) 

DAD=0. 

DO  3  K»1 ,3 

XA<  K  >»XV<  K )+DAA*SA<  K ) 

DAD»DAD+Y<K)**2 

3  BT-BT+Y<K)i.SS<IC) 

IFC DAD. LE. 1 .E-30 >  DAD»0. 

DAD=SaRTC  DAD ) 


STAOOOi 0 
3TA00020 
iSTAOOuSO 
ST,  00040 
STA00050 
STA00060 
STA00070 
STA00080 
STA00090 
STAOOl 00 
STA001 1 0 
STA00120 
STA00i30 
STAOOl  40 
STA00150 
STA00160 
STAOOl 70 
STA00130 
STA00190 
STA00200 
STA0021 0 
STA00220 
STAu0230 
STA00240 
STA0025U 
STA00260 
STA0027  0 
STA 00280 
STA00290 
STA00300 
STA003i 0 
STA00320 
STA 00330 
STA00340 
STA00350 
STA 00360 
STA00370 
8TA00380 
STA00390 
STA 004 00 
STA0041 0 
STA00420 
STA0043u 
STA00440 
STA00450 
STA 00460 
STA00470 
STA00480 
w '.9  0  0490 
STA 005 00 
STA0051 0 
STA 00520 
STA00530 
STA 00540 
STA 00550 
STA00560 
STA00570 
STA00580 
STA00590 
STA 006 00 
STA0061 0 
STA00620 
STA00630 
STA00640 
STA00650 
STA00660 
STA00670 
STA00680 
STA00690 
STA00700 
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C***  DETERMINE  DIRECT  BEAM  rtTTENUftTION  DISTANCE  RND  BIASING  DISTANCES  STA0u7;0 
C***  FOR  INITIAL  PHOTON  TRAVERSE.  STA007.i:i' 

C  STA0u73y 

CALL  ELM<XA,SA,EL>  STA0u740 

IF<BT.LE.ALIM>  GO  TO  4  STA00750 

IF<OAD,LE.< 1 . 001%DSA>)  GO  TO  4  STA0076C 

BT=0,  3TA0077U 

CT=0.  STA0078U 

DO  5  K“1,3  STA0u79o 

CT=CT+SA<K>'*SD<K>  STA0C300 

5  BT=sBT+Y<  K  JifSDt  K  j  STAOuSiu 

CTSQ^CT**^  STA0uS20 

IF< CTSQ . LE . 1 . E-30 )  GO  TO  4  STA00S30 

ELSD=ABS<BT/'CT>-DAA  STAO0S4O 

Ci=0.  STAu0a5u 

DO  6  k=1,3  STA0  0.S6  0 

6  CT»CT+<XA<K>+SA<K)*ELSD-X0<K>>>**2  STA00870 

IF<CT.GT.AkSQ>  GO  TO  4  STAOOSSO 

IF<EL<2).LE.EL<  Oi  STH=u.  biAouSSO 

1F<ELD< 1  >,LE. 0,  >  EL<2>-ELSD  STAG 09 00 

iF< DAD . LT . ALIM >  Gu  TO  4  bTAUOylO 

UDS=-BT.^DAD  STA00920 

IF<UDS.LT.UV)RETURN  STA0Ci930 

HT=1 ,+<ELSD-ELMlN>/DELD  STA00940 

IF<HT.LT.O>  GO  TO  11  3TA00950 

IF<NT.EQ.0>  NT=1  STA00960 

EN< 1 ,NT j=EN< 1 ,NTi+EXP<-GAMMAf<EL<2>-EL< 1 )>>  STA00970 

RETURN  STA00980 

4  CONTINUE  STA00990 

IF<<EL<2>-EL< 1 >>.GT. 1 .E-20>  RETURN  STAOIOOO 

IF<<SA<3).GE.  0.  ).0R.«:ALB<2>.LE.  1  .E-20>>  STH=0,  STAOlOiO 

RETURN  STA0102C 

11  STH=0.  STA01030 

RETURN  STA0t040 

END  3TA01050 
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SUBROUT  I NE  TRAVRS<  JTVPE , 1 2FLG , ICOHD  > 

COMMON, ■'RNDM/'  SEED 
COMMON,''ALL/'AT,BT,CT,BLlM 

COMMON/FRHT,,'SD<  3  ) ,  UV ,  GAMMA ,  ELO<  2  > ,  STH ,  FAC ,  AL I M ,  THV ,  TflU ,  EL<  2'j  , 
■••ALB<2),ZG,DMAX 

COMMON  /’M05XV1  ,C1  ,  SI  ,SA<  3  >^EN<  t  0>  1  00>,ENC<  1  0  > ,  ELM  I N .  DELO ,  DTOT , 
+NTMAX, NSCAM,KMAX,LMAX, LMM1 

COMMON  XBASPOT/'LK  65  > ,  SLiM<  65  ) .  WVL<  1 6  > ,  HUVL ,  ALBEC><  1  6  > .  BS<  1  6  > , 

+  BE<  16),SINGUIV,PF<65),LLMAX 
COMMON/FGEL/XA<  3  D. NSCA 

COMMON/FUD/’AKM,  R(  3 , 3  >,  AKSQ  .  XD<  3  ) ,  ASQ<  3  > ,  RE(  3 , 3  > ,  A<  3  > 

COMMON  /"CONST/PI  ,  P 1 2 ,  P I  RAO ,  TWOPl ,  TORRMB ,  CDEGK 
COMMON/CONB/X< 1 00),Y< 1 00) 

DIMENSION  SDA<3) 

DGhM=EL<  2 )-EL( i  > 

REXIT= , S5999 
RX= . 99999 
RXX=. 99999 

IF< < DGAM .LE . 0 . > . AND . < hLB< 2  )  . GT . 0 .  )  jGO  TO  9 
IFiOGAM.LE. 1 .E-7)  GO  TO  70 
IF',  I2FUG.EQ.  1  >  GO  TO  5 

IF<  <  SA<  3  ) .  GE  ,  0  .  )  .  OR  .  <  ALB<  2  )  .  LE  .  0  .  )  )REXIT=»1  .  -EXPC  -GAMMA*DGAM  > 
AT=EL< 1  )-( ALQGc 1  .-REXIT^RAND  <  SEED > > J/GAMMA 
GO  TO  4 
5  CONTINUE 

IF<ELD< 1  >.GT.ALIM)ALIM=ELD< 1 > 

RXX=<  1  .  XG AMMA  <  1  .  XAL I M  )-<  i  .  /’DGAM  >  ) 

DENOM=<<  1  ./'ALIM)-GAMMA*RXX*RAND<SEED  »> 

IF<DENOM,LE. 1 .£-7)  GO  TO  70 
AT=1 .70EN0M 

RX=EXF<  -<  GAMMA*AT  )  )*<  AT>»GAMMA  >**2 
eT=XA';3>+SA<3)*AT 

IF-:<BT.GT.ZG>.AND.<AT.LE.EL<2)>)G0  TO  2 
9  JTYPE=2 

AT=';2G-XA<3))7SA<3) 

GO  TO  1 

2  JTYPE=1 

I  STH=ALB<  JTVPE)>»<REXIT-*STH*RXX 
IF<STH.LE. 0.  >RETURN 
DO  3  K=t,3 

3  XA<K)=XA<K)+AT>*>SA<K) 

DTOT=DTOT+AT 

IF< NSCA . NE . 2  )  GO  TO  50 
AT=0 , 

DO  8  i , 3 
SDA<K)=»XD<K)-XA<K) 

8  A  I =AT+SDA< K >»SDA< K  ) 

IF<AT.LT.eLIM)GO  TO  15 
AT=SQRT<AT> 

BT=0, 

DO  32  K=1 , 3 
SDA<.  K  )=SDA<  K  )7AT 
32  BT=BT-SDA< K >*SD< K > 

IF<BT.LT,UV>  GO  TO  50 
CALL  FijRD<  SDA,  DOM,  AT  ) 

NT=1  ,-KDTOT  +  AT-ELMIN)XDELD 
IF<NT,LT. 0>  RETURN 
IF<NT,EQ. 0)  NT=1 

IF<<NT .EQ. 1 ).AND.< I2FLG,EQ.0).AND.< ICOND .EQ. 1 >)GO  TO  50 

IF<  NT . GT . NTMAX  )RETURN 

CT»0. 

BT«=0. 

DO  7  K«1,3 
BT-BT-SOA<K)*SD<K) 

7  CT“CT+9DA<K)’»SA<K) 

PFI*=1  . 

IF< JTYPE.EQ. 1 )CALL  FIND<CT,PFI) 

CALL  ELM(XA,SDA,EL) 

AT-AT-EL< 1 ) 

IF<  ELD< 1  > . GT . 0 , >AT»EL<  2  >-EL< 1 > 


TRA0001 0 
TRA00020 
TRAOuOSO 
TRA  ■'0  04  0 
TRA00050 
TRA00060 
TRA00070 
TRA00080 
TRA00090 
TRA001 00 
TRA001 1 0 
TRA001 20 
TRA00130 
7RA001 40 
TRAOOi 50 
TRA00160 
TRAOOI 70 
TRAOOI SO 
TRAOOi 90 
TRA00200 
TRA0021 0 
TRA 00220 
TRA 00230 
TRA 00240 
TRA0025U 
TRA 00260 
TRA002/'0 
TRA 00280 
TRA 00290 
TRA 003 00 
TRA0031 0 
TRA 00320 
TRA00330 
TRA00340 
TRA 00350 
TRA00360 
TRA 00370 
TRA003S0 
TRA00390 
TRA 004 00 
TRA0041 0 
TRA 00420 
TRA00430 
TRA00440 
TRA 00450 
TRA00460 
TRA00470 
~RA 00480 
ir  ■■'0  0490 
TRA 005 00 
TRA 0051 0 
TRA00520 
TRA 00530 
TRA 00540 
TRA 00550 
TRA00560 
TRA 00570 
TRA00580 
TRA 00590 
TRA00600 
TRA 0061 0 
TRA 00620 
TRA 00630 
TRA00640 
TRA00650 
TRA 00660 
TRA 00670 
TRA00680 
TRA00690 
TRA00700 
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DOMaDOM*PFI*STHt-EXP<  -GAMMAfAT  >*BT*RX 

TRA007) 0 

IF-;  12FI.G.NE.  1  >  GO  TO  1  3 

TRA 00720 

if<:nt.eq.i)  dom=dom>*io. 

TRA0073^ 

IF<NT.GT. 1 >  DOM=0. 

TRA 00740 

GO  TO  14 

TRA007d0 

13 

CONTINUE 

TRA 00760 

IF< ICOND.EQ. 1  )  DOM=DOM^0.9 

TRA 0  07,'  0 

14 

EN<NSCA,NT>=EN<NSCA,NT>+DOM 

TRA 00780 

GO  TO  50 

TRA00790 

15 

ENC<2>=ENC<2)-1  . 

TRA 003 00 

STH=0. 

TRAOOSl 0 

RETURN 

TRA 00820 

50 

CONTINUE 

TRAOOajiO 

IF< I2FLG.EQ. 1 >  GO  TO  60 

TRA 0 0840 

CALL  BKUDcJTYPE; 

TRA 00850 

6  0 

RETURN 

TRA 00860 

70 

ENCC  N3CA  >»ENC<  N3CA  >- 1  . 

TRA00870 

STH=0. 

TRA00380 

RETURN 

TRA 00890 

END 

TRA 009 00 

80 


SUBROUTINE  U3Ch<SC,US> 

COMMON  /'MOS.^VI  .Cl  .  St  ,  SR<3),EN<  t  0.  1  00  >.  ENC<  t  0  ).  ELMIN.  DELD,  DTOT, 
+HTMRX,NSCNM.KMftX.LMAX,LMM1 

common  XBftSP0TXU<65).SUM<65).WVL<'  1  6  > ,  NWVL .  ftLeED<  16>.eS<  16>. 
+BE< 16).SINGUV.PF<65>,LLMAX 
L=1 

LL=LMM1 

DO  1  K=1.KMAX 

LL»LL/'2 

L=L-^LL 

IF<  3UM<  L  ) . GT . SC )L=L-LL 
1  CONTINUE 

US=U<  L  >+<  SC-SUMC  L  >  >■»<.  U<  L+t  >-Uc  L  )  )A  SUM<.  L+  1  >-SUM<  L  )  > 

RETURN 

END 


USCuOOl 0 
USC00020 
USCC0030 
USCnr!04n 
use 00 050 
USC00060 
USC0007U 
Us  CO  Of'' 80 
USCOO69O 
USCOOt  0  0 
USCuOl 1 0 
USC  OOt  20 
use. Out  30 
USCOOt  40 
use  OOi 50 


( 
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o  o  o  o  o  Cl  o  r.i  o  o  o  C'  o  r » o  o  o  r*  r»  nnnnn  r  •  o  o  o  o  o  n  o  o  o  o  o  o  n  ca  o  n  r  *  c  r*  r.i  o  o  r.<  r*  ci  o  o  o  r  •  o  r  ■  o  o 


SUBROUTINE  3M0i<E<  UAVEi  ,  ICLMhT,  TRAMS,  lERR  >  SrtkuOu:u 

COHMON  /IOUNIT,^IOrH, lOOUT, IPHFUN, LOUN I T , ND I RTU, NCL I MT , KSTOR , NPLOTUSMK 0 0 02 ■ 
COMMON  /CLYMAT/TEMP,PRESS,RH, AH,DP, VIS,CLDAMT,CLDNVT ,  SMK0003' 

1  FOGPRB,UNDVEL,UNDDIR,  IPASCT  SMKCI0040 

COMMON  /GEOMET/  PTS<  1 5  ) , IGEOSU  SMKOC050 

COMMON  /'CONST/'PI  ,PI2,  PIRAD,  TUOPI ,  TORRMB,CC)EGK  SM;<00r,6r 

DIMENSION  IR<26>, ITTLC 11 ,5>,TSUB< 1 1  ),QD1V<  11  ) 

EXTERNAL  JPASCT  tMKOOOSO 

■Of**  NEW  PROGRAM  OPTIONS  ADDED  AS  REVISIONS  03  s.  04 

THIS  REVISION  TO  THE  MODEL  ALLOWS  THE  OPTION  OF  PRODUCING  A  ONE 
DIMENSIONAL  "SNAPSHOT"  OF  A  SMOKE  SCREEN  DUE  TO  ANY  NUMBER  OF 
MUNITIONS  AT  SOME  SPECIFIED  TIME:  OUTPUT  FOR  THIS  OPTION  IS 
CROSSWIND  TRANSMISSION  AS  A  FUNCTION  OF  DOWNWIND  DISTANCE  AT 
A  SINGLE  GIVEN  TIME  RATHER  THAN  TRANSMISSION  AS  A  FUNCTION 
OF  TIME  AT  A  SINGLE  GIVEN  LINE  OF  SIGHT. 

NEW  INPUTS  ARE  ENTERED  THROUGH  THE  “NAME"  CARD  AC; 

NAME 

STIME  =  SINGLE  GIVEN  TIME  AT  WHICH  SCREEN  IS  TO  BE  SAMPLED 
FRONT  ■=  LENGTH  OF  SCREEN  TO  BE  SAMPLED  <AL0NGWIND:) 

DELX  =  INCREMENTS  BETWEEN  CONTIGUOUS  LINES  OF  SIGHT 

MCUOPT  =  OPTION  TO  SUPRESS  INTERMEDIATE  OUTPUT  (.1  =  SUPRESS  > 

ALSO  THE  TIME  OF  DETONATION  FOR  EACH  MUNITION  IS  REQUIRED  < IN 
SECONDS)  AS  THE  FOURTH  ENTRY  ON  THE  “MUNC"  CARD 

****  THE  CAVEATS  FOR  THE  NEW  OPTION  ARE: 

1;  THE  LINES  OF  SIGHT  MUST  BE  CROSSWIND 
2)  STARTING  POINT  FOR  SAMPLING  IS  THE  OBSERVER-TARGET 
COORDINATES  ENTERED  ON  THE  “OBSC"  AND  "TARC"  CARDS 
3>  THE  PRHT  OPTION  ON  THE  "OUTP"  CARD  MUST  BE  ZERO 
4)  A  PLOT  FILE  OPTION  HAS  BEEN  ADDED  AS  THE  FOURTH  ENTRY  ON 
THE  "OUTP"  CARD  <NPLT=1  WILL  CREATE  A  PLOT  FILE  OF  THE 
FINAL  RESULTS  ON  UNIT  NPLOTU  -  SEE  EOMAIN) 

SMKOOCiSCi 

NOTE:  THE  FOLLOWING  COMMON  BLOCK  ALLOWS  MUNITION  BURN  DURATION  SMKOOlOO 

AND  OBSCURATION  PERIODS  UP  TO  16.0  MINUTES  <960  SEC)  SMK00110 

TO  ALTER  PERIOD,  CHANGE  MAXS  AND  DIMENSIONS  OF  SMAS,  PVOL  AND  SMK00120 

CLTOT.  SMK00130 

SMK00140 

COMMON  /'M05/'  SMAS<  96  0  ) ,  PVOLC  960  >,  CLTOT<  960  ),  SMTRAN(  7  ) ,  R 1  <  9  > ,  SMKOOtSu 

*EXTC<8),ZL<2  ),XL<2  ),  YL<2  >,XINT<2),YINT<2>,2IHT<2>,  IFLAG(2>  SMKOOieO 

DATA  MAXSZ960Z  SMK00170 

DATA  QDIV  ZO. , .3, .50, .60, .65, .70, .80, I . 0, 1 . , 1 , , 1 SMKOOISO 

SMK0<190 

NOTE:  FOR  SHORTER  OR  LONGER  BURNS  AND  OBSCURATIONS,  USERS  MAY  SMKC'O'  O 

SUBSTITUTE  FOR  THE  COMMON  BLOCK  AND  MAXS  PARAMETER  AND  ALTER  SMK002  O 

DIMENSIONS  FOR  SMAS,  PVOL  AND  CLTOT.  SMK 00220 

SMK 00230 

SMOKt  MODEL  SMK0u24ij 

FORMAL  INPUTS:  SMK 00250 

WAVE1  =  WAVELENGTH  IN  MICROMETERS  < OR  94.  GHZ)  FROM  ALLOWEDSMK00260 


BANDS  <SEE  EXTC  RECORD  BELOW). 

ICLMAT  =  CLIMATOLOGY  FLAG.  IF  1  THEN  .''CLYMATZ  VALUES  OVER¬ 
RIDE  METR  RECORD  VALUES. 

IGEOSW  *  GEOMETRY  FLAG  FROM  COMMON  GEOMET .  IF  SET 
TO  1  IN  EOMAIN,  THEN  OBSERVER  AND  TARGET 
COORDINATES  ARE  PASSED  TO  SMOKE,  AND  ANGLE 
XNORTH  SET  TO  90.  DEGREES. 

FORMAL  OUTPUTS: 

TRANS  =  TRANSMISSION  AT  TIME  ETO  < DEFAULT)  OR  USER 
SPECIFIED  TIME  <SEE  OUTP  RECORD  BELOW)  FOR 
WAVELENGTH  WAVE1  ALONG  THE  OBSERVER-TARGET 
LINE-OF-SIGHT . 

lERR  =  ERROR  FLAG.  1  IF  ERROR  IN  SMOKE. 

USER  RECORDS  INPUT: 

EACH  CARD  BEGINS  WITH  A  4  LETTER  IDENTIFIER  IN  COL  1-4, 

FOLLOWED  BY  AS  MANY  < REAL )  FIELDS  AS  NEEDED,  10  COL. 
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PER  FIELD  BEGINNING  IN  COL  11.  THE  CARDS  ARE  NOT  ORDER 
DEPENDENT  ALTHOUGH  VALUES  ON  EACH  RECORD  MUST  FOLLOW  THE  ORDER 
SHOWN  IN  COMMENTS  BELOW.  FORMAT  < 2A2, bX , 7h 1 0 . 3 > 

THE  FOLLOWING  ARE  REQUIRED  RECORDS  FOR  AT  LEAST  ONE  INPUT  SET. 

DESCRIPTION 


IDENT. 

VARS. 

MUNC 

XM,YM,2M,TM 

<M,M,M,SEC) 

BART 

STO 

ETO 

DTO 

ANGLX 

MUNITION  COORDINATES  AND  EVENT  TIME 


COMPUTATION  TIMES  AND  X-AXIS  DEFINITION; 
OUTPUT  STARTING  TIME  <SEC.  SINCE  IGNITION) 
ENDING  TIME  FOR  CALCULATION  CSEC.) 

TIME  INCREMENT  FOR  OUTPUT  TABLES  <SEC) 

ANGLE  OF  POSITIVE  X-AXIS  WRT  NORTH 

<DEG.  CLOCKWISE  WRT  NORTH)  ASSUMED  90  DEG. 

IGEOSW  IS  1  FROM  EOMAIN 


OPTIONAL  DEPENDING  ON  PARAMETERS  CHOSEN: 


IDEHT. 


VARS. 


DESCRIPTION 


OBSC  X0,Y0,20 
TARC  XT,YT,ZT 
OUTP 


PRNT 


CRITER 


TIMTRN 


IPLT 


MUNT 


XN 

FW 


TBURN 

TYPE 


EFF 


OBSERVER  COORDINATES  < IGNORED  IF  IGEOSW 
IS  1  FROM  EOMAIN).  <M,M.M) 

TARGET  COORDINATES  < IGNORED  IF  IGEOSW  IS 
1  FROM  EOMAIN)  <M,M,M) 

OPTIONAL  RECORD  TO  SELECT  AMOUNT  OF  PRINT 
AND  TO  SELECT  CRITERIA  FOR  RETURNED 
TRANSMISSION. 

IF  0.,  ALL  FULL  OUTPUT  LISTINGS  CREATED. 

IF  1 .  IS  ENTERED  AT  ANY  POINT,  THEN  ALL  FURTHER 
OUTPUT  IS  SUPPRESSED,  EXCEPT  FOR  THE  FINAL 
ACCUMULATED  EFFECTS  LISTING  OF  TOTAL  CL  AND 
TOTAL  TRANSMITTANCE  FOR  COMBINED  MULTIPLE  INPUT 
SETS.  < DEFAULT  IS  PRNT  =0.) 

SELECTS  CHOICE  OF  TRANSMISSION  RETURNED  FROM 
SMOKE. 

0.  »  RETURN  TOTAL  TRANSMITTANCE  COMPUTED  AT 
LAST  TIME  ETO.  < DEFAULT  CASE) 

1 .  -  RETURN  THE  MINIMUM.  VALUE  OF  TOTAL 

TRANSMITTANCE  COMPUTED  FOR  WAVELENGTH 
WAVEI ■ 

2.  -  RETURN  VALUE  OF  TOTAL  TRANSMITTANCE  FOR 

WAVELENGTH  WAVEI  COMPUTED  AT  USER- 
SPECIFIED  TIME  TIMTRN  BELOW, 

REQUIRED  ONLY  IF  CRITER  IS  2,,  TIME  FOR  WHICH 
TRANSMITTANCE  RETURNED  IS  COMPUTED.  SHOULD  BE 
CLOSE  OR  EQUAL  TO  A  TABLE  TIME  < AS  DETERMINED 
THE  BART  RECORD)  FOR  ACCURACY. 

PLOT  CODE  ADDED  IN  ORDER  TO  PLOT  OUTPUT  ON  UNIT 
NPLOTU  IF  IPLT  -  1 . 

REQUIRED  IF  BURN  RECORD  IS  NOT  USED.  OTHERWISE, 
OPTIONAL.  ANY  NON-ZERO  VALUES  INPUT  WILL  OVER¬ 
RIDE  PREVIOUS  SOURCE  DEFINITIONS  < INCLUDING 
THOSE  FROM  THE  BURN  RECORD.) 

NUMBER  OF  MUNITIONS  IGNITED  AT  THE  SAME 


Si'1K0043  0 
S  ■',k:0044  0 
Sr‘ 004D0 
SM...  0  046  0 
SMi<0047u 
SMK004S0 
SMkCi0490 
SMKOOSOO 
SMKOusI 0 
SMK 00520 


S.'-'!K  0  053  0 
SMk 00540 
SMK 0 0530 
SMK00560 
SMK 00570 
SMKOOdBO 
IFSMK00590 
SMK 006 00 
SMK 0061 0 
SMK 00620 
SMK00630 
SMK 00640 
SMK 00650 
SMK  0  0660 
SMK00670 
3MK00680 
SMK 00690 
OUTPUT3MK00700 
SMK 0071 0 
SMK00720 
SMK 00730 
SMK00740 
SMK00750 
SMK00760 
SMK 00770 
SMK00730 
SMK00790 
SMKOOSOO 
SMK 0081 0 
SMK 00820 
3MK00330 
SMK 00840 
SMK 00850 
SMK 00860 
SMK00870 
SMK 00880 
'^MK  0  089  0 
oi,K00900 
BYSMK0091 0 
SMK00920 


FILL  WEIGHT  OF  ONE  MUNITION  <LBS.)  FOR  SMKOIOiO 

WP,PWP,HC  OR  RP  <BUT  RATE  OF  BURN  SMK01020 

IN  GAL. /HR.  FOR  FOG  OIL.  NOTE  1  GAL/HR*  SMKOIOSO 
0.93  G/S>  SMK 01 040 

BURN  DURATION  FOR  THIS  MUNITION  < SEC  )  SMKOIOSO 

TYPE  OF  SMOKE  (DIMENSIONLESS)  SMK01060 

=WP,  2.=PWP  OR  WP  WICK/WEDGE,  3.=HC,  SMK01070 

-FOG  OIL,  5.-RP  SMKOIOSO 

MUNITION  BURN  EFFICIENCY,  (PERCENT)  SMK01090 
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0000000000000000000000000000000000000000000000000000000000000000000000 


METR 


EXTC 


BURN 


YF 


RELHUM 

UUI 

UNDIR 


PCAT 

AIRT 

TGRAD 


IF  INPUT  AS  0..  THEN  DEFAULT  IS  USED.  SMkOIIO' 

YIELD  FACTOR  < DIMENSIONLESS > .  IF  0,,  DEFAULTSSMKC 11 ' 
TO  RELATIVE  HUMIDITY  DEPENDENT  STRAIGHT 
LINE  FIT  FOR  WP.PWP.RP  FROM  JOHNSON 
AND  FORNEY.  SIMILARLY  FOR  HC .  FOG  OIL 
SET  TO  1 . 

REQUIRED  IF  ICLMAT  IS  ZERO,  OTHERWISE, 

NEEDED  ONLY  FOR  E  OR  F  PASQUILL  CATEGORY 
PROVIDE  TGRAD  WHICH  IS  NOT  AVAILABLE  IN 
/■CLYMAT/' , 

RELATIVE  HUMIDITY  cPERCENT) 

WIND  VELOCITY  <  M/^SEO 
WIND  DIRECTION  < USUAL  MET  CONVENTION, 

ANGLE  IN  DEG.  CLOCKWISE  FROM  NORTH  OF 
DIRECTION  FROM  WHICH  WIND  ORIGINATES.) 

PASOUILL  CATEGORY  < DIMENS  I ONLESS > 

1.-A,  2.-6,  3.-C,  4.-0,  S.-E,  b.-F 
SURFACE  AIR  TEMPERATURE  (DEG  C) 

VERT  Temp  uRADItNT  <C  DtG/’M). 

EXAMPLE:  TGRAD=< AIRT< 1 0  M)-AIRT<.5  M>)/S, 

(USED  ONLY  hOR  PASOUILL  CATEGORIES  t, 


SMKOI 

12 

SMKO< 

1  3 

f'f 

IS  SMKO 

1  4 

n 

SMKO- 

1  5 

V 

'  ,mk  ;  ■ 

i  6 

0 

ilKi.  1 

i  T 

0 

TO  SMKOI 

va 

0 

SMl:  -0  1 

0 

SMK  0 1 

2  0 

0 

SMKO  1 

21 

0 

SMK  0 1 

22 

0 

SMk.  0 1 

23 

0 

SMK  0  1 

24 

0 

SMKOI 

25 

0 

SMk  0  ’ 

26 

0 

SMKOI 

2?' 

0 

SMK  0 1 

26 

0 

SMKOI 

29 

0 

SMK  0  ■! 

30 

0 

5  M 
F> 


OPTIONAL  USER 
COEFFICIENTS. 

IF  RECORD  NOT  USED,  OR  FOR  ANY 
IN  AS  0.,  THE  EXTINCTION  COEFF 
DEFAULTS  TO  ALPHA  ARRAY  VALUE  IN  STRANS 


OVERRIDE  FOR  EXTINCTION 

VALUES  READ 


INPUT  EXTINCTION 
CORRESPONDS  TO 
0.4-0. 7  ■ 

0.7-1  .2 
1  .  OS 
3. 0-5. 0 
8.0-12. 
10.6 
94 , 0 


COEFF.  <M*>»2.''G:>  order  ON  CARD 
THE  BANDS : 

MICROMETERS 

MICROMETERS 

MICROMETERS 

MICROMETERS 

MICROMETERS 

MICROMETERS 

GHZ. 


OPTIONAL  -  SELECTS  BUILT-IN  MUNITION  CHARACTER¬ 
ISTICS  FROM  THE  BRATE  ROUTINE  FOR  ONE  <XN=1) 
MUNITION,  VALUES  ARE  FOR  FILL  WEIGHT  (FIO),  BURN 
DURATION  (TBURN),  SMOKE  TYPE  <ITYPE>,  EFFICIENCY 
<EFF).  YIELD  FACTOR  IS  SET  TO  ZERO  SO  THAT  RH 
MODEL  DEPENDENT  VALUES  ARE  USED.  ANY  VALUES  READ 
IN  AS  NON-ZERO  ON  A  MUNT  RECORD  (WHICH  IS 
OPTIONAL  IF  A  BURN  CARD  IS  USED.^  WILL  OVERRIDE 
THE  DEFAULTS  STORED  IN  BRATE. 


TVPM 


MUNITION 
0.  * 
1  .  ■ 
2.  = 

3. 

4. 

5  . 

6. 

7. 

8. 

9. 

10. 

1 1  . 
12. 

13. 

14. 

15. 

16. 

17. 

18, 


TYPE: 

USER  DEFINED 
155MM  HC,  Ml 


MUNITION  SOURCE  CHAR, 
CANISTER . 

155MM  HC,  M2  CANISTER, 

105MM  HC  CANISTER. 

155MM  HC  Ml 16B1  PROJ. 

105MM  HC  M84A1  PROJ. 

SMOKE  POT  HC  05 

60MM  UP  M302  CARTRIDGE 

81  MM  WP  M375A2 

4,2  IN  UP  M32eAl 

155MM  UP  Ml  1 0E2 

105MM  WP  M60A2 

4,2  IN  PUP  M328A1 

5,  IN  PUP  ZUNI  MK4 

2.75  IN  WP  WEDGE  SUB-MUNITION, 

3.  IN  WP  WICK  SUB-MUNITION 

6.  IN  WP  WICK  SUB-MUNITION 
155MM  WP  WEDGE  XM825  <92  SUB-MUN ,  ) 
SIMM  RP  WEDGE  NAVY  SUB-MUNITION 


SMKOl 51 0 
SMKOi 520 
SMKOI 350 
SMkOi  5<»0 
SMKOI 350 
SMK0i360 
SMKO! 370 


SMKOI 580 
SMKOI 390 
SMKOI 400 
SMKOI 41 0 
SMKOI 420 
SMK01430 
SMK01440 
SMKOI 450 
SMKOI 460 
SMK01 470 
SMKO i 48 0 
SMK01490 
SMKOI 500 


SMKOI St  0 
:?'iK0l520 
Si':'<01  53  0 
SMKC’ 540 
SMKO-:  35  0 
SMKO  .  -  ■  ') 
SMKO-.,  ‘ 
5MK  0 1 


SMKOI 

SMK  0  1 

SMKOI 

SMKOI 

SMK  0 

SMKO: 

SMKOI 

SMKOI 

SMKO 


SMKC 

SMKO 

SMKO 

SMKO 

SMKO 

SMKO 

SMKO 

SMKO 

SMKO 

SMKO 

SMKO 

SMKO 


59  J 
6  00 
610 
620 
630 
640 
650 
660 
670 
680 
690 
700 
71  0 
720 

73  0 

74  0 

75  0 
760 
’70 
78  0 
190 
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BRAT1 

BRBT2 

BRAT3 

BRAT4 


19.  ■  SIMM  RP  WEDGE  GERMAN  SUB-MUNITION 

20.  *  tSSMM  RP  WEDGE  XM803  <228  SUB-MUN 

21.  ■  FOG  OIL  GENERATOR  < EXAMPLE; 
BURN-RATE  COEFF .  < CONST.  TERM> 

BURN-RATE  COEFF.  < LINEAR  TERM) 

BURN-RATE  COEFF.  <OUADRATIC  TERM) 

BURN-RATE  COEFF.  < CUBIC  TERM) 

RATE  COEFF.  ARE  BASED  ON  THE  SCALED 
POLYNOMIAL  DESCRIBING  THE  FRACTIONAL 
MASS  BURNED  AT  SCALED  TIMES  FROM  0. 

< IGNITION)  TO  1.  < BURN-OUT).  THE  INTEGR 
OF  THE  POLYNOMIAL  FROM  0.  TO  1,  MUST 
BE  1.,  IE.  THE  SCALED  TOTAL  MASS  BURNED 
BY  TIME  1.  IS  100  PERCENT.  THE  PROGRAM 


NITION  SMK01800 
UB-MUN. )  SMK01S1 0 
SM*"' J1S20 
SMk01830 
SMKOl 840 
SMK01850 
SMKOl 860 
ED  SMKOl 870 

NAL  SMK01880 

0.  SMKOl 890 

INTEGRAL  SMKOl 900 
UST  SMK01910 

BURNED  3MK01920 
ROGRAM  SMK01930 


BRATS 


WILL  CHECK  FOR  THIS  CONDITION  AND  Rt-SCALESMKO 1 94 0 
COEFF.  IF  NECESSARV ,  SMKOl 950 

i  SPECIAL  BURN  RATE  COEFFICIENT  FOR  ESTIMATING  SMKOl 960 

THE  RAPID  BURST  FOLLOWED  BY  SLOW  BURN  OF  SMK01970 

SOME  MUNITIONS.  THE  FUNCTIONAL  FORM  OF  SMK01980 

THE  TERM  MULTIPLYIED  BY  BRATS  IS  SMKOl 990 

.07818  <358800.  /  <  1  .  +  358600.  T7TBURN))  SMK02000 

THOSE  MUNITIONS  FOR  WHICH  THE  RATE  IS  NOT  SMK02010 
MODELED  WILL  RECEIVE  BRAT1=1.,  BRAT2,3,4,5  =0SMK02020 
<IE.,  CONSTANT  BURN-RATE).  THE  USER  MAY  SMKC2030 

OVERRIDE  THE  DEFAULT  RATES  BY  ENTERING  VALUESSMK02040 


ON  THE  BURN  CARD. 

NAME  SCREEN  PARAMETERS 

STIME  TIME  AT  WHICH  GREEN  IS  EXAMINED 

FRONT  SCREEN  FRONTAGE  TO  BE  EXAMINED 

OELX  INCREMENTAL  SPACING  FOR  SCREEN  EXAMINATION 

MCUOPT  OPTION  TO  SUPRESS  INTERMEDIATE  OUTPUT  WITH 

MCU  STUDIES  OPTION  <MCU0PT=1  WILL  SUPRESS) 

THE  FOLLOWING  IDENT  RECORDS  ARE  ALWAYS  REQUIRED. 

GO  SIGNIFIES  TO  BEGIN  EXECUTION  FOR  THIS  DATA  SET, 

AFTER  EXECUTION,  ANOTHER  SET  OF  INPUTS  MAY  BE 
READ-IN  FOLLOWED  BY  ANOTHER  'GO'  CARD, 

ANY  VALUES  ESTABLISHED  FROM  PREVIOUS  INPUT  SETS 
TO  THE  ROUTINE  ARE  STILL  IN  EFFECT.  THUS  DATA 
SUCH  AS  FROM  CARD  06SC  NEED  NOT  BE  READ  AGAIN  IF 
THERE  ARE  TO  BE  NO  CHANGES  TO  OBSERVER  COORD., ETC, 

DONE  *■*■■«>  MUST  ***  BE  THE  LAST  RECORD  READ.  DESIGNATES 

LISTING  OF  ACCUMULATED  EFFECTS  IF  MORE  THAN  ONE 
INPUT  SET  < DELINEATED  BY  GO  CARDS)  WERE  INPUT. 

ALSO  RETURNS  CONTOL  TO  EOSAEL  EXEC  MODULE. 

NOTE  THAT  A  -DONE'  CARO  CAN  BE  USED  IN  PLACE  OF 
THE  FINAL  'GO'  CARD  IF  DESIRED. 

OUTPUTS 

LIST  OF  INPUT  PARAMETERS  AND 

AT  EACH  COMPUTATION  TIME,  TO,  THE  FOLLOWING: 


YFULL 

PATHL 


SMTRAN 


SMK02u50 


SMK02060 
SMK02070 
3MK020S0 
SMK02090 
SMK021 00 
SMK021 1 0 
SMK02120 
SMK021 30 
SMKC2140 
SMK02150 
SMK02160 
SMK021 70 
SMK021 80 
3MK02190 
SMK 02200 
''MK0221  0 

,r\  0c^22  0 

SMKi)2230 
SMK02240 
SMK 02250 
SMK02260 
SMK02270 
SMK 02280 
SMK02290 
SMK0230U 
SMK0231 0 
SMK02320 


SUBROUTINES  CALLED. 


CLOUD  LENGTH  ALONG  WIND  VECTOR  <M)  SMK02280 

CLOUD  LEADING  EDGE  HEIGHT  ALONG  WIND  VECTOR  SMK02290 
<M>  SMK0230U 

CLOUD  LEADING  EDGE  FULL-WIDTH  PERPENDICULAR  SMK02310 
TO  WIND  VECTOR  <M).  SMK02320 

SMOKE  LENGTH  OF  1  MUNITION  ALONG  OBS-TCT  LOS  SMK02330 
<M)  SMK02340 

TOTAL  CL  OF  SMOKE  ALONG  OBS-TGT  LOS  <  GM,‘’M**2  )SMK02350 
FOR  XN  MUNITIONS.  SMK02360 

TRANSMISSION  IN  SPECTRAL  BANDS  OF  SMOKE  ALONGSMK02370 
LOS  SMK02380 

SMK 02390 

DIRECTLY!  CLSMOK,  SCONST,  SMASSP,  JPASCT,  SMK02400 
WGGEOM,  STRANS,  BRATE..  INDIRECTLY!  XYZINT,  QROOT .  SMK02410 

SMK02420 

.2HE  ,2HPH,2H0S,2HPH,2H0R,2HUS,2H  <,2HWP,2H)  ,SMK02430 


WGGEOM,  STRANS,  BRATE..  INDIRECTLY:  XYZINT,  QROOT. 
DATA  ITTL/  2HWH,2H1T,2HE  , 2HPH, 2H0S, 2HPH, 2H0R, 2HUS, 2H  <,2HWP,2H) 
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I 


1 

5 


C’*"*'* 

20 

C’tof’f 


80 

30 

90 


2H  , 

SMK 02 4-  ' 

2H  . 

SMKOa*" 

2H  , 

SMK02''b', 

2H  / 

SMKP247n 

0B,2HSC,2HTA. 

SMK  02^.8  0 

2HTP. 2HD0. 

SMK C 2 TO 
5MK025U0 
SMK0251 0 

PCAT, 

SMK02520 

SMK0253C 

SMK02540 

>)> 

SMK02550 
SMK 02560 
3MK02570 
SMK  0253  0 
SMK 02590 
SMK 026 00 

-f  2HHC,2H  S,2HM0,2HKE,2H  ,  2H  >2H  ,2H  ,  2H  ,  2H  , 

♦  2HF0,2HG  ,2H0I,2HL  , 2HSM , 2H0K , 2HE  , 2H  ,2H  , 2H  , 

*  2HRE,2HC)  ,2HPH,2H0S,2HPH,2H0R,2HUS,2H  <,2HRP,2H>  > 

DATA  IR  /’2HME.2HTR,2HMU,2HNT,2HBA.2HRT,2HMU,2HNC,2^ 

♦2HRC.2HEX,2HTC,2HG0.2H  ,2HBU,2HRN  , 2HMI , 2HSC , 2H0U ; 

♦2HNE  ,2HNA,2HME  / 

DATA  BRAT1 , BRAT2 , BRAT3 , BRAT4 , BRAT5/1 . , 0 . , 0 , , 0 . j  \ / 

DATA  TYPM,XN,FU,TBURN,EFF, YF,RELHUH,UW,UNDIR, ANGLX, 

♦AIRT.TGRAD 
DATA  ITGRAD/0/ 

BFUH<  T  >=Th.<  brat  1  +T*<  BRAT2^2  .  +Tk<  BRAT3/3 .  +T*BRAT4/’4  , 

*+BRAT5* . 0781 828tt*AL0G< 1  . +358800 . *T  > 

NUMDIV=8 
HRUHS=0 
TIMTkN=1 , 

ICRTft=0 
TRANS=1 . 

MCUOPT=0 

NOPP.NT=0 

NOMORE=0 

NCY=0 

DO  1  J=1,HAX3 
CLT0T<  J>=:0. 

CONTINUE 
DO  cl  1  j  B 
>  EXTC<J)=0. 

CONTINUE 

NRUNS=NRUNS+1 

MUNRD=0 

KUAVE=0 

IF  <WAVE1 .GE, 0,4.AND.WAVE1 .LT. 0.7>  KWAVE-1 
IF  <UAVE1  .GE.  0.7.AND.WAVE1  .LE.  1  .2>  (<WAVE-2 
IF  <UAVE1 .GE.3. 0.AND.UAVE1 .LE.5.0>  KUAVE>4 
IF  CUAVEt .GE.8. 0.AND.UAVE1 .LE. 12. 0>  KUAVE«5 
IF  <WAVE1  .GT.I  .059.AND.WAVE1  ,LT.1 .061  >  KWAVE=*3 
IF  <WAVE1 .GT.10.59.AND.WAVE1 .LT.10.6O  KWAVE=6 
IF  <WAVE1 .GT.93.9.AND.WAVE1 .LT.94,1 >  KWAVE=7 
IF  <UAVE1  .GT. 3188.  .AND. WAVE1  .LT. 3195.  )  KUIAVE=7 
IF  <KWAVE.EGi.  0)  GOTO  998 
BEGINNING  OF  READ  LOOP 
NCHK=0 

DO  70  I  =  1,  15 

1F< I .EQ. 15)  GO  TO  310 
READ< IOIN,20  )  IR1 , IR2, < R1 <  J  ), J=1 , 7 > 

FORMAT<  2A2 , 6X , 7F 1 0 . 3 ) 

RELATING  INPUT  DATA  TO  VARIABLE  NAMES. 

IF<IR1 .EQ,IR<1 ).AND.IR2.EQ.IR<2)>  GOTO  90 
IF<IR1  .EC(.IR<3).AND.IR2.EQ.IR<4>)  GOTO  100 
IF< IR1 .EQ . IR< 5) . AND. IR2 .EQ. IR<6 )>  GOTO  110 
IF< IR1 .EQ. IR<7>.AND. IR2.EQ. IR<8)>  GOTO  120 
IF<IR1 .EQ.IR<9).AND.IR2.EQ.IR<10>)  GOTO  130 
1F< IR1  .EQ. IR< 1 1  ).AND. IR2.EG. IR< 12>>  GOTO  140 
IF<IR1 .EQ.IR<13).AND.IR2.EQ.IR<14))  GOTO  150 
IF< IR1 .EQ. IR< 15).AND,IR2.EQ. IR< 16)>  GOTO  155 
IF<IR1 .EQ.IR< 17).AND.IR2.EQ.IR<18>>  GOTO  105 
IF<IR1 .EQ.IR<19).AND.IR2.EQ.IR<20>>  GOTO  70 
IF< IR1 .EQ. IR<21  ).AND.IR2.EQ. IR<22>>  GOTO  115 
IF<  IR1 .EQ. IR<23).AND. 1R2.EQ. IR<24>>  GOTO  154 
IF<IR1 .EQ.IR<25).AND.IR2.EQ,IR<26))  GOTO  121 
WRITE< lOOUT.SO) 

FORMAT<1H  ,72NINVALID  DATA  CARD-DOES  NOT  CONFORM  TO  PROPER 
INVENTION  IN  SMOKE  ROUTINE) 

WRITE< IOOUT,30)  IR1 , IR2,<R1<  J), J«1 ,7) 

FORMAT<1H  ,2A2,6X,7F1 0.3) 

GO  TO  999 

IF  < ICLMAT.EQ. 1 )  GOTO  92 
IF  <RI<  1  ).NE.  0.  )  RELHUM-RUI) 

IF  <R1<2).NE.  0.  )  UU  -  R1<2> 

IF  <R1<3).NE. 0. .0R.R1<2>.NE. 0. >  WNDIR  »  R1<3) 


SMKOCbl 0 

SMK02620 
SMK02b30 
SMK02640 
3MK02b50 
SMK02660 
SMk 02670 
SMK02680 
SMK 02690 
SMK  02  f' 00 
SMK 027 1 0 
SMKCt2720 
SMK 02, w  0 
SMK0274I' 
SMK 02750 
SMK02760 
SMK02770 
SMK 02780 
SMK 02790 
SMK 028 00 
SMK 0281 0 
SMK02820 
SMK 02630 
SMK 0284  0 
SMK 02850 
SMK02860 
SMK 02870 
SMK0;360 
SMK02S'^C' 
SMK02r>,'0 
SMK  029)  ■' 
SMK 02920 
SMK0293<'^ 
SMK02940 
SMK 02950 
SMK 02960 
SMK  0297 '■) 
SMK 02980 
SMK 02990 
SMK03000 
SMK0301 0 
SMK03020 
SMK 03 030 
COSMK03040 
SMK03050 
SMK 03 060 
SMK03070 
SMK03080 
SMK 03 090 
SMKfC'l  00 
SMK031 i 0 
SMK03' 20 
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A 


IF  <R1<4).NE. 0. >  PC^T  ■  Rl<4> 

ICftT=IFIX<PCAT+ . 0001 > 

AIRT  =  RU5) 

TGRAD  =  R1<6) 

ITGRAD»i 

NCHK=1 

GO  TO  70 

IF  <R1< 1 >.NE. 0.  >  XN  -  Rl< 1 > 

IF  (R1<:2i.HE.  0.  >  FU  =  Rl<2> 

IF  <Rl<3>.NE.0.j  TBURN  «  Rl<3> 

IF  <R1<4>.NE.  0.  >  ITVPE  »  IF1X<  RU  4  >♦  .  0001  ) 

IF  <HUNRD.ECi.O.OR.R1<5>.NE.O.  >  EFF  =  RK5> 

VF-R1<6> 

MUNRD=1 

NCHK=1 

GO  TO  70 

TVPM=R1< 1 > 

CALL  BRATE< lERR, MUNRD, TYPM, XN, FW, TBURN, ITVPE, EFF , YF, BRAT1 , 
■»BRAT2,BRAT3,BRAT4, BRATS  ) 

IF  <IERR.HE.O)  WRITE  <100UT,95>  TYPM 

F0RMAT<37H  IN  SMOKE,  ILLEGAL  MUNITION  TYPE  READ  ,F5.0) 

IF  < lERR.NE. 0)  GOTO  999 

IF  <R1<2i.Eu.0.  .AHD.R1<3i.EQ.  0.  .  AND .  RU  4  > .  ED .  0  .  .  AND  .  R 1  <  5  ; .  EQ .  0  . 


,  0R.R1<5>.NE. 


=  RK5> 


BRATi*R1<2) 
BRAT2=R1<3> 
BRAT3=R1 <  4  j 
BRAT4=R1<5> 
BRAT3=*R1  <  b  > 
IF  <TYPM.GT. 
NCHK=1 


GOTO  93 


MUNRD= 


GO  TO  70 

ISTO  =  IFIX<R1< 1 >+.0001 ) 
lETO  =  IFIX<R1<2>+.000t  > 
lOTO  =  IFIX<R1<3)+.0001  ) 
ANGLX=R1<4> 

NCHKsI 

GO  TO  70 

NOPRNT*0 

IF  <R1< 1  ).NE. 0. )  NOPRNT-1 
CRITER»R1<  2  ) 
ICRTR=IFIX<CRITER+.001 ) 

IF  <  ICRTR.GT.2)  ICRTR-2 
IF  ( ICRTR.LT. 0>  ICRTR=0 
IF  <ICRTR.EQ.2>  TIMTRN*R1<3> 
IPLT=IFIX<R1<4  >> 

GOTO  70 

XM  »  R1< 1 > 

YM  =  R1<2) 

ZM  =  R1<3) 

TM  =  R1<4) 

NCHK^I 

GO  TO  70 

MODE-1 

STIME  =R1< 1  ) 

ISRN  »IFIX<STIME+0.0001 ) 
FRONT  =R1<2> 

DELX  -R1<3> 

IFCDELX.LE. 0. 0>  DELX«5.0 
XXX»FR0NT7DELX 
NPTS-IFIX< XXX >+1 
MCU0PT=IFIX<R1<4>) 

GO  TO  70 

XO  =  R1< 1  ) 

YO  =>  R1<2) 

ZO  =  Rl<3) 


bMK03130 
SMK03140 
SMr 03150 
SMK03160 
SMK03170 
SMK 03180 
SHK03190 
SMK03200 
SMK 0321 0 
SMK03220 
3MK03230 
SMK03240 
SMK032b0 
3MK03260 
SMK03270 
SMK 03260 
3MK03290 
SMK 033 00 
SMK0331 0 
SMK03320 
SMK03330 
SMK:03340 
SMK03350 
SMK03360 
SMK 03370 
SMK033&0 
3MK03390 
SMK 034 00 
3MK034i 0 
SMK03420 
SMK03430 
SMK 05440 
SMk'05430 
SMK03460 
SMK03470 
SMK03480 
SMK03490 
SMK03500 
SMK 0351 0 
SMK 03520 
SMK03530 
8MK03540 
SMK03550 
SMK03560 
SMK 03570 

SMK03580 
■MK 03590 
SKiK-OSSOO 
SMK 0361 0 

SMK03620 

SMK03630 


R1<  1  > 
R1<2> 


GO  TO  70 


SMK03640 

SMK03650 

SMK03660 

SMK03670 

SMK03680 

SMK03690 

SMK03700 
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R1<3; 


2T  -  R1<3; 

NCHK'=I 

GO  TO  70 

J50  DO  152  J=1,7 
152  EXTC<  J>-R1<  J+O 
EXTC<8>=0. 

70  CONTINUE 
154  NOMORE=1 

IF  <NCHk.EQ.0>  NRUN8«HRUNS-i 
IF  <NCHK.EQ. 0>  GOTO  980 
155  CONTINUE 

C******REDEFINE  MUNITION  EFFICIENCY  IF  INPUT  AS  ZERO 
IF<EFF.GT. O. 0)GO  TO  11 
IF< ITYPE.EQ. 1 >EFF=1 00. 

IF<  ITVPE.ECi.2  jEFF=b5.0 
IF< ITVPE.EQ.3>EFF=40. 0 
IF< ITVPE.EQ.4>EFF=1 00. 0 
IF<  ITYPE.EQ.5>EFF=5Ci. 

1  1  CONTINUE 

IF  < ICLMAT.NE. 1 >  GOTO  12 
RELHUM=RH 
UW  =UNDVEL 
UNDIR=yNDDIR 
I CAT  =IPASCT 
PCAT=FLOAT< ICAT ) 

AIRT  =TEMP 
12  CONTINUE 

IF  < IGEOSW.NE. 1  )  GOTO  13 
DISKTM=1 000. 

C...  CONVERT  UNITS  FROM  KM  TO  M. 

XT=PTS< 1  )*DISKTM 
YT=PTS<2)*DISKTM 
ZT=PT3<3>*DISKTM 
X0*PTS<4)*DISKTM 
Y0=PTS<5)*DISKTM 
Z0=PTS<6>*DISKTM 
ANGLX=90. 

13  CONTINUE 

IF  < ITYPE.LT.  1  .OR. ITYPE.GT.5)  IERR=1 
IF  <IERR.EQ,1)  WRITE  <IOOUT,180>  ITYPE 
180  FORMAT< IX, 31HIN  SMOKE,  INVALID  SMOKE  TYPE  =  ,14) 
IF  < lERR.EQ. 1  )  GOTO  999 

C**f  CHECK  BURN  RATE  FOR  100  PERCENT  BURN  AT  TBURN... 
IF  <BRAT2.EQ. 0, . AND . BRATS . EQ . 0 . . AND . BRAT4 . EQ . 0. . 
♦BRAT1=1 . 

VNORM»BFUN< 1 . ) 

BRAT1=BRAT1/VN0RM 
BRAT2=BRAT2/VN0RM 
BRATSaBRATS/VNORM 
BRAT4=BRAT4XVN0RM 
BRAT5=BRAT5XVN0RM 
IF  CXN.LE. 0, >  XN=1 . 

IF  < ITYPE.EQ. 1 .AND. TBURN. GT. 1 . >  TBURN-1 . 

C-***  SET  UP  EXTINCTION  COEFF  TO  BE  USED... 

CALL  STRANS<CL,SMTRAN, ITYPE , EXTC, 0 ) 


AND. BRATS. EQ. 0. > 


TBURN-1 . 


CALL  SMASSP<XN,EFF,FW,RELHUM,  W, ITYPE, YF>  SMK04240 

TGR-TGRAD  SMK04250 

TCRAD=ABS<TGRAD)  SMK04260 

IF  <N0PRNT.EQ. 1 .AND.NRUNS.CT. 1 )  GOTO  255  SMK04270 

IF  <MCUOPT.EQ. 1 .AND.NRUNS.CT. 1 )  GOTO  255 

IF<NRUNS.GT. 1 )  WRITE  <I00UT,172)  NRUNS  SMK04280 

IF<NRUNS.EQ. 1 )  WRITE  <IOOUT,1720)  NRUNS  8MK04290 

>  FORMAT<  1H1 ,50X,  17<  lHi<)X51X,  IN*,  15X,  1H*X51X,  1Hi',5X,5HSM0KE,5X,  SMK043  0  0 

♦  IH*, 15X,9HEXECUTI0N  , I3/51X, IN*, 15X, IH^/SIX, 1 7< IH*  )/ >  SMK043’n 

20  FORMAT<  1H0,50X,  17<  1  H*  )X51  X,  1 H* ,  1 5X,  1  HfXSl  X,  1  Ht.,  5X,  5HSM0KE,  5X,  SMK04c2  0 

flHf, 15X,9HEXECUTI0N  , 13/51 X, 1 H* , 15X, 1 H*/5 1 X, 1 7C1 H* >7 >  SMK04330 

Kf  REPORTING  INPUT  DATA.  SMK04340 

I F< I  CAT . GE . 5 . AND . I  TYPE . NE , 4 . AND . I TGRAD . EQ . 0  >WR I TE  < I OOUT , 98  )  TGR ADSMKC435  0 
98  F0RMAT<  1X,44H1N  SMOKE  ROUTINE  PASQUILL  CATEGORIES  E  AND  F,  SMKCi4360 

f29H  REQUIRE  TEMPERATURE  GRADlENT/1 OX, 23HIF  SMOKE  IS  EXOTHERMIC.,  SMK04370 


SMKOj.  ^  '■ 
SMK037:'y 
SMK  037^  ^ 
SMK037‘V(j 
SMK037S0 
SMK037t.  : 
SMk  r'3^  / 1'- 
SMKOS^O ' 
SMK  03  9  6 
SMK03306 
SHK  056 1 0 
SMK  0362  0 
SMK  038 j  0 
SMK 03840 
SMK0385CI 
SMK 03860 
SMK 03870 
SMK 03880 
SMK03S90 
SMK 039 00 
SnK0591 0 
SMK039Z0 
SMK05930 
SMK  0394  0 
SMK 03950 
SMK03960 
SMK03970 
SMK.  0358  0 


SMK 03990 
SMK04  0t,0 
SMK  04  01 
SMK04020 
3MK04030 
SMK 04 040 
SMK04050 
SMK04060 
SMK04070 
SMK040S0 
SMK04090 
SMK041 00 
SMK 04 1 1 0 
8MKC4120 
SMK 041 30 
SMK04140 
SMK-'.-^'ISO 
SMKv  '-0 
SHKO-t  .  7  0 
SMK  04 1  0 
SMK 04 190 
SMK 042 00 
SMK 0421 0 
SMK04220 
SMK 04230 
SMK04240 
SMK04250 
SMK04260 
SMK04270 


SMK04280 
8MK04290 
SMK04300 
SMK043’ 0 
SMK 043 20 
SMK 04330 
SMK04340 


ee 


,F7.2,25H  C  DEG/M  WILL  BE  MSSUMti> .  /  > 


170 


190 


200 


21  0 


215 


<*20H  H  VALUE  OF  TGRAD 
WRITE< lOOUT, 170) 

F0RriAT<5X, 15HSM0KE  MUNITIONS, 22X,25HMETE0R0L0GICAL 
123HEXT1NCTI0N  COEFFICIENTS) 

WRITE< lOOUT, 190)  < ITTL<  J, ITVPE), J-1 , 1 1 >,UW,EXTC< 1  > 


FORMAT<  3X, 1 1 A2, 1 IX, 1 OHWINDSPEED  , 14X,F5. 1 , 2X,3HM/S, 16X, 
120H0.4-0.7  MICROMETERS  ,  F7 . 3, 2X,  7HM-*>*2/GM  ) 

WRITE< IOOUT,200)  XN,EXTC<2> 

FORMATOX,  1  OHNO.  ROUNDS ,  1 X, F5 . 0,  1 7X, 22HWIND  DIRECTION  <USUAL 
120H0.7-1.2  MICROMETERS  ,  F7 . 3, 2X,  7HM*i'2/GM  > 

IF  <ITYPE.NE.4)  URITE< lOOUT , 21 0 )  FU , UNDIR, EXTC< 3  ) 


SMk' 04380 
SMK04390 
CONDITIONS, 25X, SMK 04400 
SMK  ,4410 
3MK04420 


SMK04430 
SMK 04440 
SMK04450 
,28X,SMK04460 
SMK 04470 
SMK04480 


F0RMAT<3X, 1  INFILL  WE IGHT , F8 . 3 , 3H  L8 , 1 1 X , 23HMET  CONVENTION  AZIMUTH )SMK04490 
1  ,F6. 1 ,2X,7HDEGREES, 12X, 20H1  . 06  MICROMETERS  , F7 . 3, 2X, ZHMf^Z/GM >  SMK04500 
IF  <ITYPE.EQ.4>  WRl  TE<  lOOUT  ,  2 1 5  )  FW,  UINDIR,  EXTC<  3  >  SMK0451  0 

F0RMATt3X,9HBURN  RATE , 2X , F6 . 1 , 2X, eHGAL/HR ,  8X,23HMET  CONVENTION  AZSMK04520 


MICROMETERS  ,F7.3,2X, 


220 


235 


250 

255 


1  IMUTH)-  ,F6. 1 ,2X,7HDEGREES,  12X,20H1  .  06 
WRITE< lOOUT, 220 )TBURN, RELHUM, EXTC<  4  ) 

FORMATOX,  9HBURN  TIME,  F8 . 1 , 2X ,  3HSEC,  1 1X,  17HRELATIVE  HUMIDITY,  7X, 
1F5. 1 ,2X,7HPERCENT, 12X,20H3. 0-5 . 0  MICROMETERS  , F7 . 3, 2X, ZHMi'fZ/GM ) 
LCAT=JPASCT< ICAT) 

WRITE< IOOUT,230)  EFF , LCAT, EXTC<5 ) 

230  FORMAT<3X,  1  OHEFFICIENCY,  IX, F6. 1 , 2X,  7HPERCENT ,  7X,  17HPASG!t  ILL 
1RY,9X,A1,23X,20H8,0-12.  MICROMETERS  , F7 . 3, 2X, 7HM**2/GM  ) 

WRITE  <I00UT,235>  YF, AIRT, EXTC< 6 > 

F0RMAT<3X, 12HY1ELD  FACTOR, F6. 2, 15X, 15HAIR  TEMPERATURE , 8X , F6 . 1 ,2X, 
18HDEGREE  C,  1  1  X,  20H1  0 . 6  MICROMETERS  ,  F7 . 3, 2X ,  7HM*>*<2/'GM  > 

WRITE< IOOUT,240)TCRAD,EXTC<7) 

240  F0RMAT<36X, 14HTEMP.  GRAD lENT, t OX, F6 , 2, 9H  C  DEG./M,11X, 

1 1 1H94, 0  GHZ,9X,F7.3,2X,7HM**2/GM) 

IF  < ICAT.GE.5.AND.TGR.LT,0.  )  URITE< lOOUT, 250 ) 

F0RMAT<36X,24H< ASSUMED  POSITIVE  INPUT >> 

NRAT=0 

- 

NRAT=2 
NRAT=3 
NRAT-4 

1 .AND.NRUNS.GT. 1 > 

1 .AND.NRUNS.GT. 1 > 


181 


179 

175 

176 

177 

178 


258 


IF 

IF 

IF 

IF 

IF 

IF 

IF 

IF 

IF 

IF 

IF 


<BRAT1 .NE. 0.  ) 
<BRAT2.NE.0.  > 
<eRAT3.NE. 0. > 
<BRAT4.NE. 0.  ) 
<NOPRNT.EQ. 
<MCUOPT.EQ. 


<NRAT.EQ. 1  ) 
<NRAT.EQ,2) 
<NRAT.EQ.3) 
<NRAT.EQ.4) 
<NRAT.EQ. 0) 


WRITE 

WRITE 

WRITE 

WRITE 

WRITE 


GOTO  258 

_  _  GOTO  258 

<I00UT,175>  BRATl 
(lOOUT, 176)  BRATl, BRAT2 
<I00UT,177)  BRATl ,BRAT2,BRAT3 
<  lOOUT, 178)  BRATl ,BRAT2,BRAT3,BRAT4 


SMK 04530 
SMK04540 
8MK04550 
SMK04560 
SMKC4570 
SMK04580 
SMK04590 
CATEGOSMK04600 
SMK0461 0 
SMK04620 
SMK04630 
3MK04640 
SMK04650 
SMK04660 
SMK04670 
SMK04680 
SMK04690 
SMK04700 
SMK0471 0 
SMK(i4720 
SMK04730 
SMK 04740 
8MK04750 


< lOOUT, 181 ) 

FORMAT<40X, 19H8URN  RATE  PROFILE  «) 

IF  < BRATS. NE. 0.  )  NRAT-5 
NPWP=0 

IF  << ITYPE.EQ.Z.OR. ITYPE.EQ.5).AND.NRAT.GT. 1  )  NPWP«1 
IF  (NRAT.EQ.S)  WRITE  <I00UT,179)  BRATS 

FORMAT<40X,2H+  ,  F8 . 4, 4 1  H’fO  .  0781 829*<  3588 00  .  .'C  1  .+358800 
FORMAT< 1H0,40X, 19MBURN  RATE  PROFILE  =,F8.4) 

FORMAT< 1H0,31X, 19HBURN  RATE  PROFILE  =,F8,4,2H  +, 

♦F8,4, 1  OH  (T/TBURN)) 

FORMAT< 1H0,20X, 19HBURN  RATE  PROFILE  =,F8,4,2H  +, 
■*F8,4,12H  (T/TBURN)  ♦,F8,4,13H  <  T/TBURN  )>»»2  > 

FORMATdHO,  9X,19HBURN  RATE  PROFILE  »,F8.4,2H+  , 
♦F8,4,12H  (T/TBURN)  +,F8,4,15H  <T/TBURN)+>*2  +,F8.4, 

•  13H  <T/TBURN)'**3) 

PROVIDE  COORDINATES. . . 

AMGLaANGLX+1 80 . -WNDIR 

IF  < ANGL.GT.360, >  ANGL-ANGL-360 , 

IF  (ANGL.LT.O.  )  ANGL>=ANGL+36  0 . 

IF  (NOPRNT.EQ. 1 .AND.NRUNS.GT. 1 )  GOTO  285 

XPl-XO-XM 

XP2*XT-XM 

YP1»YO-YM 

YP2=YT-VM 

ZPPl-ZO-ZM 

ZPP2=ZT-2M 

CA<=COS(ANCLx<PIRAD) 


8MK04760 
SMK04770 
SMK04780 
SMK04790 
SMK04800 
SMK0481 0 
SMK04820 
SMK04830 
?MK04840 
3ri,x04850 
+T7TBURN )  )  )SMK  04860 
SMK 04870 
SMK04880 
SMK 04890 
SMK04900 
SMK0491 0 
SMK04920 
SMK04930 
SMK04940 
SMK04950 
SMK04960 
SMK04970 
SMK 04980 
SMK04990 
SMK05000 
3MK0501 0 
SMK05020 
SMK 05030 
SMK 05 040 
SMK05050 
SMK 05 060 
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SH=SIN<ANGL*PIRrtD>  SMkOSO'j 

XPP3=0,  SMK  05 

YPP3=0,  SHk.05u^ 

ZPP3=0,  SMKoyio: 

XPP 1  *XP  1  •CA+VP1  fSA  SHKOSili' 

YPP1  =YP1  ♦CP-XPIt'SH  SMKfiSir’ 

XPP2=XP2*CA+YP2*Sft  S.  i  OSi  ■  ' 

YPP2=YP2*CA-XP2*SA  SkKi;5;4 

IF  <MCUOPT.EQ. 1 . AHD.NRUNS.GT. 1 >  GO  TO  285 

WRITE  <  I00LlT,26Ci>  SHk^SlSu 

WRITE  <IOOUT,270)  XM, YM, ZM, XPP3, YPP3, 2PP3, XO, YO, ZO , XPP 1 , YPP t ,  SMK05160 

12PP1 ,XT, YT,2T,XPP2,YPP2,ZPP2  SMK05170 

FORMAT< 1H0,30X, 17HF1ELD  COORDINATES , 20X> 43HR0TATED  COORD, <WIHD  X-ASMK05130 


SMK 05280 
SMKti529  0 


1XIS,  MUNITION  ORIGIN)/'27X,3H<X),8X,3H<Y),8X,3H<Z),20X,4H<:XW>.  SM)<05190 

27X,4H<YU),7X,4H<ZU)>  3MK05200 

FORMAT< 1X,22HMUNIT10N  COORDINATES*  , 3< F9 . 2 , 2X >, 6HMETERS , 6X ,  SMKOSZIO 

13(F9.2,2X>,6HMETERS/1X,22N0BSERVER  COORDINATES*  ,3CF9.2,2X>,  SMK05220 

26HMETERS,6X,3<F9.2,2X),6HMETERS/1X,22HTARGET  COORDINATES*  ,  SKK0523C 

33<F9,2,2X),6HMETERS,6X,3<:F9.2,2X),6HMETERS>  SMK0524  0 

WRITE  <I00UT,275)  ANGLX.TM  SMKOSZSO 

FORMAT< 1X,48HANGLE  OF  ORIGINAL  X-AXIS,  CLOCKWISE  WRT  NORTH  *  ,  SMK05260 

*F7,2,5H  DEG. ^/^SX, 12HEVENT  TIME  =,F6.1,4H  SEC >  SMK05270 

IF<M0DE.GT. 0)  WRITEC lOOUT, 1000)  MODE, STIME , FRONT , DELX 
3  F0RMAT<5X,5HM0DE-, I2,X,5X, 1 2HSCREEN  TIME*,F6. 1 , / , 5X , 6HFR0NT* , F6 . 1 , 

*/,5X, 1 1HINCREMENT*  , F6 . 1  ) 

IF  <NOPRNT.EQ.l .0R.MCU0PT.EQ.1 )  GO  TO  285 

1F<M00E.EQ. 0)  WR1TE< IOOUT,280)  SMK05280 

IF<M0DE.GT. 0)  WRITE< lOOUT, 281 > 

FORMAT< 1H0,6X,4HTINE,3X,6HLENGTH,3X,5HW1DTH,4X,6HHEIGHT,2X,  SMKti5290 

1 1 0HPATHLENGTH,4X,2HCL,24X, 12HTRANSMISSI0N,/',7X,5H(SEC>,3< 1 X , 8H< METSMK 053 0 0 
2ERS  )  ) ,  2X,  8N<  METERS  > ,  2X ,  9H<  GM/M'»>*2  ),  1 2X,  28HSPECTRAL  BANDS  <  MI CROMETSMK  053 1  0 

3ERS),X,60X,39H0.4-0.7  0.7-1. 2  1.06  3 . 0-5 . 0  8.0-12.,  SMK05370 

415H  1  0.6  94.  GHZ,/*)  SMK  0533 1 

FORMAT< 1HO,6X,5H>*LOS*,3X,6HLENGTN,3X,5HWIDTH,4X,6HHEIGHT,2X, 1 OHPAT 
1HLENGTH,4X,2HCL,24X, 12HTRANSMISSI0N,/,4X,8H< METERS >, 3< 1 X , 8H< METERS 
2  )  ), 2X, 8H<  METERS  ), 2X, 9H<  GMXM**2  >, 12X, 28HSPECTRAL  BANDS  <  MICROMETERS 
3),X,60X,40H0.5 -0,7  0.7-1. 2  1.06  3 . 0-5 , 0  8,0-12., 

415H  10.6  94.GH2/') 

BEGINNING  OF  CALCULATIONS.  SMK05340 

IF  (W.EG.O.)  GOTO  999  SMK07370 

IF  < ICAT.LT. 1 .OR. ICAT.GT.6>  GOTO  999  SMK05360 

IF< lOTO.EQ. 0)  IDTO  *  1  SMK05370 

IF  <ISTO.LE.O)  ISTO=IDTO  SMK05380 

IF  < lETO.LE. ISTO)  IETO=ISTO  SMK05390 

CALCULATIONS  DEPENDENT  ON  TINE.  SMK05400 

SET  COMPUTATION  TIME  STEP  DTIME  TO  1  SEC,  FOR  HCXFOC  OIL/PWPX  SMK"5410 

RP  AND  WP  WICKb/UEDGES  SMK  '5420 

BUT  TO  TABLE  REPORT  TIME  INCREMENT  FOR  WP  SMKu:.430 

DTIME=FLOAT< IDTO )  3MK05440 

TRANS*1.0  SMK05450 

T3UB<1>=0.  3MKOS4feO 

TSUB<2)=TBURN  SMK 05470 

IF  <NPUP.EQ.0>  GOTO  620  SMK 05480 

IS*IFIX<5,>*TBURN+.0001  >  SMK05490 

IF  CIS.LT.I)  GOTO  610  SMK055C0 

DO  286  1«2,NUMDIV  SMKOSSIO 

TSUB< I  )*1 ./5.  SMK05520 

CONTINUE  SMK05530 

DO  600  1*1, IS  SMK05540 

FI=FLOAT< I )/5.  SMK05550 

T=FI/’TBURN  SMK05560 

TMS-BFUN<T>  SMK05570 

DO  601  JDIV-2,NUMDIV  SMK055S0 

IF  <TMS.LE.001V< JD1V)>  TSUB< JOIV)»FI  SMK05590 

CONTINUE  SMK 058 00 

TSUB<NUMDIV>-TBURN  SMK 056 10 

CONTINUE  SMk05620 

GOTO  620  SMK 05630 

NPWP*0  SMK 05640 

CONTINUE  SMK C 5650 


SMK 05340 
SMK:07370 
SMK05360 
SMK05370 
SMK05380 
SMK05390 
SMK 054 00 
SMK "541 0 
SMK  '5420 
SMKu3430 
SMK05440 
SMK05450 
SMK 05460 
SMK05470 
SMK 05480 
SMK 05 490 
SMK055C0 
SMK 0551 0 
SMK05520 
SMK05530 
SMK0554O 
SMK05550 
SMK05560 
SMK05570 
SMK055S0 
SMK 05590 
SMKOSSiiO 
SMK 0561 0 
SMK 05620 
SMK 05630 
SMK 05640 
SMK C 5650 
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IF  <ITYPE.GE.2>  DTlME-1 . 

NDIV=NUMDIV-1 
DO  700  JPUP=1,NDIV 

IF  < JPWP.GT. 1 . AND.NPWP.EQ. 0)  GOTO  700 
TSTPGE*TSUB<  JPWP  > 

TBRN=TSUB<  JPWP+1 >-TSTAGE 
PCNT=QDIV<  JPUP+1 )-QDIV<  JPUP  ) 

IF  <HPWP .EQ. 0)  PCHT-I . 

IF  <TBRN.LE.0.>  GOTO  700 

CALL  SCONST< ICAT.UW, ITYPE, FU, EFF, TBRH, NPUP , AIRT, TGRAD , Cl ,C2,C3. 

♦  XN;XLIM,  YLII1.2L1M,HLIM,TL1M,XS,CNEUT,PCNT,W> 

PCT*PCNT*i 00 

IF  <NPWP.HE.O.AHD.NOPRNT.NE.1  >  WRITE  <100UT,705>  PCT , TSUB< JPUP 
♦TSUB< JPWP+1 > 

IF  <HPWP.NE. 0. AND.MCUOPT.NE. 1 >  WRITE  <IOOUT,705>  PCT, TSUB< JPUP ), 
+TSUB< JPWP+1 > 

705  FORMAT< 1X,30H  +++  CLOUD  PORTION  CONTAINING  ,F7.3,35H  PERCENT  OF  S 
*OKE  DURING  BURN  FROM  ,F7.2,3H  T0,F7.2,4H  SEC^/> 

CL=0. 

ICODE-0 

TO=0. 

NCY=0 

ICALL=0 

ISTT=ISRN-IFIX<TH+0, 0001) 

II  =  lFIX<Ti«l> 

XPP0=XPP1 

I1=ISTO 

I2»I£T0 

I3-IDT0 

NHH=1 

IF<M0DE.EQ,0>  GO  TO  2000 
I1=ISTT 

12- 1STT 

13- 1 
II-O 

NNN-NPTS 
TO-0 . 

2000  CONTINUE 

DO  6  J*1,NNN  * 

IF  <!TYPE.EG.1)  TO-FLOAT< 1 1 )-DTlME 

DO  6  1-11,12,13 

L-I-II 

IF<MODE.EQ.1 >  XPP1=XPP0+< J-1 >*DELX 

IF<MODE.EQ. 1 )  XPP2-XPP1 

X-0. 0 

Y-0. 0 

Z-0. 0 

PATHL-0. 0 

CL=0 . 0 

IF<L.LT. II >  GO  TO  2001 

C*m*  TAB  IS  NEXT  TABLE  REPORT  TIME,  TO  IS  NEXT  COMPUTATION  TIME. 
TAB=FLOAT<  L )-TSTAGE 
IF  <TAB.GT. 0. >  GOTO  3 
IF  <NCY.GE.MAXS)  GOTO  6 
NCY-NCY+l 
GOTO  6 

3  TO-TO+OTIME 

CALL  WGGEOM< ICALL,CLCAUS, ITYPE,XPP1 ,YPP1 ,ZPP1 , XPP2, YPP2, ZPP2, Cl , 
1C2,C3,T0,UW, ICAT,HLIM,TLIM,CNEUT,XS,PATHL,X,Y,Z,XL1M,YLIM,2L1M> 
CALL  CL8M0K( I CODE , CLGAUS , 1 TYPE , CL , W , PATHL , TBURN , TBRN , PCNT , TSTAGE , 
■•■NPWP.XHM,YL1M,ZLIM,T0,TLIM,0TIME,X,Y,2,BRAT1  ,BRAT2,BRAT3,BRAT4, 
•BRATS ) 

C+**  REPORT  OUTPUT  DATA  IF  TIME  TO  .EG.  TAB,  OTHERWISE,  LOOP 
C***  BACK  FOR  NEXT  TIME  STEP... 

IF  <T0.LT.<TAB-. 001 )>  GOTO  3 
2001  CALL  STRANS<CL,SMTRAN, ITYPE,EXTC, 1 > 

YFULL-2.4Y 
TV-FLOAT< 1 >-TM 
XWR1T-FL0AT< 1 > 

IF<MODE.CT. 0>  XWR1T-XPP2+XN 


3MK05660 
SMK05670 
SMK 05680 
SMK05690 
SMK 057 00 
SMK 0571 0 
SMK 05720 
SMK05730 
SMK 05740 
SMKC5750 
SMK05760 
SMK 05770 
SMK 05780 
SMK 05790 


SMSMK 05600 
SMK 0581 0 
SMK 05820 
SMK05830 
SMK 05840 
SMK05S50 
SMK05860 


SMK 05870 
SMK 05880 


SMK05390 
SMK05900 
SMK0591 0 
SMK 05920 
SMK 05930 
8MK05940 
SMK05950 
SMK 05960 
SMK 05970 
SMK05980 
SMK 05990 
SMK 06000 
SMK0601 0 
SMK 06 020 
SMK 06 030 
SMK 06 040 
SMK06050 
8MK06060 


( 
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L 


290 


700 
98  0 


982 


PkHTuP=NOPRNT 

IF  <MODE.GT,0)  PRNTOP=HCUOPT 

IF  <PRNTOP.NE.n  URITE< IOOUT,290>  XURIT,X, YFULL, Z,PATHL, CL, 
*<SMTRAN<K>,K=«1 ,7) 

FORMAK  6X , F5 . 0 , 2X , F6 . 0 , 3X , F6 . 0 , 3X , F6 . 0 , 4X, F6 . 2 , 4X , F7 . 2 , 7<  3X , F5 . 3 

IF  <  ICRTR.EQ.2.AND.TV.GT.<TiriTRN+,5))  GOTO  7 

IF  < ICRTR.EQ, 1 .AND.SMTRAN<XUAVE).GE.TRANS>  GOTO  7 

TRTM=TV 

TRANS=SMTRAN<  KUAVE  '> 

CONTINUE 

IF  <NCY.GE.HAXS)  GOTO  6 
NCY=NCY+1 

CLTOT<  NCY  >=CLTOT< NCY  >+CL 
i  CONTINUE 
CONTINUE 
FINAL  OUTPUT. 

IF  <NOMORE.EQ. 0)  GOTO  5 
IF  <NCY.LE. 0)  GOTO  999 
IF  <NRUNS.LE. 1 .AND.NPwP.EQ. 0)  GOTO  997 
IF<HOC>E,EO.  0)  WRITE<  I00UT,982)  NRUNS 
IF<HOr)E.GT.  0)  URITE<  I00UT,984)  NRUNS 


EFFECT  OF  ,13,21H  EXECUTIONS  IN  SMOKE 
<C/'M>»f<2),21X,  12HTRANSMISSI0NX 


3.0-5.08.0-12.  10.6  94.GHZX) 

EFFECT  OF  ,13,21H  EXECUTIONS  IN  SMOKE 
<G/'M**2),21X,  12HTRANSMISSI0N/' 


0-5.0  8.0-12. 


10.6  94. GHZ/) 


F0RMAT< 1H1 ,40X, 19HC0MBINED 
>••1  OX,  1  OHTIME  <SEC),5X,  1  1HCL 

•  1  OX,  1  0<  1H-),  5X,  1  1<  1H-),4X, 

>»54H0.4-0.7  0.7-1  .2  1.06 

984  FORMAT< 1H1 ,40X, 19HC0MBINED 

♦  1  OX, t 1HL0S< METERS ),4X,  t IHCL 

*  1  OX , 1 0< 1 H- ) , 5X , 1 1 < 1 H- > , 4X , 

■••54H0.4-0.7  0.7-1. 2  1.06  3 

TRANS=1 . 0 
DO  985  1=1, NCY 
CL=CLTOT< I > 

TO=FLOAT<  ISTO+<  1-1  )-»IOTO> 

CALL  STRANS<CL,SMTRAN, ITYPE,EXTC, 1 ) 

YWRIT=TO 

IF<MODE.GT. 0)  YWRIT=XPPO+XM+< 1-1 )*DELX 
WRITE  <I00UT,983)  YWRIT,CL,<3MTRAN< J>, 4=1 ,7) 

IF< IPLT.EQ. 1 )  WRITE<NPl6tU,883>  YWRIT,CL 
FORMAT< 1X,F6. 1 ,2X,F8.3) 

FORMAT< 12X,F6. 0,8X,F8.2,6X,7< 1X,F5.3,2X>) 

IF  < ICRTR.EQ.2.AND.TO.GT.<TIMTRN+.5)>  GOTO  985 
IF  < ICRTR.EQ. 1 .AND. SMTRAN<KWAVE).GE. TRANS)  GOTO  985 
TRTM=TO 

TRANS=SMTRAN<  KWAVE ) 

CONTINUE 
CONTINUE 

WRITE  < lOOUT.SI 00 )WAVE1 , TRANS, TRTM 
TRANS=SMTRAN<  KWAVE ) 

RETURN 

998  WRITE  <IOOUT,3200) 

GOTO  999 

3100  FORMAT< 1HO,5X,37H***TRANSMISSION  RETURNED  TO  MAIN  FOR 

1  14HWAVELENGTH  OF  ,F8.3,16H  MICROMETERS  IS  ,F5.3, 

2  8H  AT  TIME  , F7 , 0 ) 

3200  FORMAT< 1H0, I OX,3SHINVAL10  WAVELENGTH  PASSED  FROM  MAIN 
1  ,//,10X,27H  TRANS*1.0  RETURNED  TO  MAIN,//) 

310  CONTINUE 
C**-*-  ERROR  CONDITION 
WRITE<100UT,320) 

320  F0RMAT<1H  , 1 05HM0RE  THAN  13  DATA  CARDS  HAVE  BEEN  INPUT  . 
>»ECK  THAT  THERE  ARE  NO  MORE  THAN  13  DATA  CARDS  PER  RUN.) 

999  CONTINUE 
IERR=1 
TRANS-1 . 0 

RETURN 

END 


883 

983 


985 

997 


PLEASE 


SMK06070 
SMK 06080 

>)SMK06090 
SMK061 00 
SMK061 1 0 
SMK 061 20 
SMK06130 
SMK 06140 
SMk061 50 
SMK 06160 
SMK06170 
SMK06180 
SMK 06190 
SMK06200 
SMK0621 0 
SMK06220 
SMK 06230 
SMK 06240 

•./SMK  06250 
SMK 06260 
SMK06270 
SMK06260 

:/ 


SMK05290 
SMK 063 00 
SMK0631 0 
SMK 06320 
SMK 06330 


SMK 06340 


SMK 06350 
SMK06360 
SMK06370 
SMK 06380 
SMK06390 
SMK06400 
SMK0641 0 
SMK06420 
SMK0e430 
SMK06440 
SMK 06450 
SMK 06460 
SMK06470 
SMK06480 
SMK 06490 
SMK 065 00 
SMK0651 0 
SMK06520 
SMK06530 
SMKG6540 
CHSMK06550 
SMK 06560 
SMK 06570 
SMK 06580 
SMK 06590 
SMK06600 
SMK 0661 0 
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) 


* 


noooooooooooooonooooonoooorioorinnorionooorio  oooo 


bUBROUTINE  CLSMOKt ICODE, CLGi^US , ITVPE, CL, U , P^THL , TBURN, TBRN,PCNT,  CLSOOul 0 
•TSTflGE,NPWP,XLIM, YLIM, ZLIM,T0,TLIM,DTII1E,X,Y,2,BRAT1 ,BRPT2,  CLS00020 

♦BRPT3,BRAT4, BRATS)  CLS00030 

COMMON  /C0NST/Pl,PI2,PIRAD,Ty0PI,T0RRMB,CDEGK  CLS00040 

COMMON  /lOUNlT/IOIN, lOOUT , IPHFUN , LOUNI T , NDIRTU, NCLIMT , KSTOR , NPLOTUCLS0005 0 

CLS00060 

NOTE;  THE  EOLLOUINC  COMMON  BLOCK  ALLOUS  MUNITION  BURN  DURATION  CLS00070 

AND  OBSCURATION  PERIODS  UP  TO  16.0  MINUTES  <960  SEC >  CLSOOOSO 


COMMON  /M05/  SMAS< 960 >, PVOL< 960 >, CLTOT< 960 >, SMTRAN< 7 >, R1< 9 > , 
■••EXTC<8),2L<2),XL<2),YL<2),XINT<2),YINT<2>,2INT<2),IFLAG<2> 

NOTE:  TO  CHANGE  MAXIMUM  BURN  OR  OBSCURATION  DURATION,  CHANGE 
PARAMETER  MAXS  AND  DIMENSIONS  OF  SMAS, PVOL, CLTOT  TO  MAXS 

THIS  SUBROUTINE  CALCULATES  THE  VOLUME  OF  THE  SMOKE  CLOUD  AND 


CLS00070 
CLSOOOSO 
CLSOOOSO 
CLS001 00 
CLS001 1 0 
CLS00120 
CLS001 30 
CLS00140 
CLS00150 
CLS00160 


THE  CONCENTRATION  ■*<  LEHGTH<CL>  AT  THE  INTERSECTION  OF  THE  OBSERVERCLS001 70 


TARGET  LOS  OF  THE  CLOUD  FORMED  BY  THE  TOTAL  NUMBER  OF  SMOKE 


CLS00180 


MUNITIONS  WHICH  WERE  DETONATED  AT  THE  SAME  TIME  AND  FROM  THE  SAME  CLS00190 


POINT.  FOR  CONTINUOUS  TYPE  BURNS  <HC.FOG  OIL,  PWP,  RP,  AND 
WP  WICKS  OR  WEDGES),  THE  BURN  MASS  INCREMENT  AND  PATH  LENGTH 
TO  VOLUME  RATIO  ARE  STORED  FOR  EACH  PUFF,  THESE  PUFFS  ARE 
SUBSEQUENTLY  ADDED  TO  FIND  THE  TOTAL  EFFECT  OF  OBSCURANT. 


INPUTS 


I  CODE 
ITYPE 


PATHL 

TBURN 

NPWP 


A  FLAG  TO  BE  SET  BY  USER  TO  0  ON  FIRST  CALL 
TO  PROGRAM,  WHICH  WILL  THEN  RESET  IT  TO  1 . 

SMOKE  TYPE  1»MP,  2=PWP  OR  WP  WICK7WEDGE 
3-HC,  4-FOG  OIL,  5-RP 

SMOKE  MASS  PRODUCED  BY  XN  MUNITIONS  <C  FOR 
TYPES  1-3  AND  5,  C/'S  FOR  TYPE  4) 

PATHLENGTH  OF  SMOKE  CLOUD  AS  IT  INTERSECTS  THE 
OBSERVER-TARGET  LINE  OF  SIGHT  <M> 

TOTAL  LENGTH  OF  TIME  OF  BURN  <S> 


CLS00200 
CLS0021 0 
CLS00220 
CLSu02b0 
CLSu0240 
CL3 00250 
CLS00260 
CLS00270 
CLS00280 
CLS00290 
CLS00300 
CLS0031 0 
CLS 00320 
CLS00330 
CLS00340 
CL300350 


FLAG  FOR  PWP/RP/'WP  WICKS  OR  WEDGES.  IF  NON-ZERO,  CLS00360 


OUTPUTS 


THEN  BURN  IS  IN  23  PERCENT  <OF  W)  STAGES. 

TBRN  PARTIAL  BURN  DURATION  THIS  STAGE  <SEC) 

TSTAGE  START  OF  PARTIAL  BURN  <SEC> 

XLIM, YLIM,ZLIM  DIMENSIONS  < LENGTH, HALF-WIDTH, HEIGHT > 
OF  CLOUD  AT  END  OF  EXOTHERMIC  RISE  TIME  <M) 
TO  TIME  AFTER  IGNITION  <S> 

TLIM  TIME  OF  TERMINATION  OF  HEAT  RISE  <S> 

DTIME  TIME  INCREMENT  OF  COMPUTATION  <S> 

ENDTIM  ENDING  TIME  OF  COMPUTATION  <S> 

X,Y,Z  CURRENT  LEADING  EDGE  CO-ORDINATES  <M) 

BRAT  1,2, 3, 4  POLYNOMIAL  BURN  RATE  COEFF . 

CLGAUS  UNIT  CONTRIBUTION  FROM  GAUSSIAN  PUFF. 

CL  COMPUTED  CL  IN  <G/M#>»2>  FOR  THIS  MUNITION  SET. 


**■<•  SIMPLE  FOR  INSTANTANEOUS  BURN  OF  WP 

BFUN<  T  )-T-<  BRAT1  +Ti'<  BRAT2,^2 .  ♦T-*<  BRAT3/3 .  +Tf BRAT474 .  >  >  >+BRAT5>* 
-0. 07818288»ALOG< 1 . +358800. -T> 

MAXS-960 

IF  < ITYPE. GT. 1 >  GOTO  1  00 

VOL-0.25>»<4.><'PI«^3.  >  •*X*Y*2 

CL»Wii<  .25-PATHL/VOL  +.75  i*CLGAUS> 

RETURN 

C*—  INITIALIZE 
100  CL-0. 

IF  <ICODE.NE.O>  GOTO  110 

ICODE-1 

IB-0 

IPL-0 

START-0. 

BRNOUT-FLOAT< IFIX<  ,9999+TBRN)) 

HRAT-2 

IF  <6RAT2.EG. 0. .AND.BRAT3.EQ. 0. .AND.BRAT4.EQ. 0. >  NRAT-1 
IF  < BRATS. NE. 0. )  NRAT-5 


CLS00370 
CLS003d0 
CLS00390 
CLSD0400 
CLS0041 0 
CLS00420 
CLS00430 
CLS00440 
CLS00450 
CLS00460 
CLS00470 
CLS00480 
CLS00490 
CLS00500 
CLS 0051 0 
CLS00520 
CLS00530 
CLS00540 
CLS00550 
CLS00560 
CLS00570 
CLSOOSdO 
CLS00590 
CLS00600 
CLS0061 0 
CLS00620 
CLS00630 
CLS00640 
CLS00650 
CLS00660 
CLS00670 
CLS00680 
CLS00690 
CLS00700 
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K3UB=0 

TClTPV=0. 

BR-U 

IF  <ITYPE.NE.4>  BR«W^BRNOUT 
IF  <NPWP.NE.O>  BR-BRkPCNT 
IF  <BRNOUT.LE, t .  >  NRPT=1 
IF  <NkAT.GT.1>  BTHEH=BFUN<TSTAGE/^T6URN> 
C***  STORE  PUFF  MASS  EMITTED  AT  TIME  TO 
ttO  IF  <T0.GT.8RN0UT>  GOTO  120 
IF  <IB.GE.MAXS>  GOTO  120 
I6=IB-i-i 

IF  <NRAT.E0.1 >  GOTO  120 

IF  ( 1B.EQ.MAXS>  WRITE  <IOOUT.SOO>  IB 


CLS0071 0 
CLS00720 
CLS00730 
CLS00740 
CLS00750 
CLS00760 
CLS00770 
CLS00780 
CLS00790 
CLSOOSOO 
CLSOOBi 0 
CLS00820 
CLS00B30 


900  FORMAT< 1X,61H*>*%  WARNING  -  IN  SMOKE,  MAXIMUM  STORAGE  FOR  BURN  DURACLS00840 
*TION  OF  ,I5,55H  SEC  IS  FULL.  ACCURACY  BEYOND  THIS  POINT  DECREASES . CLS00850 
*  )  CLS00860 

TM=TO  CLS00870 

IF  <TO.GT.TBRN>  TM=TBRN  CLS00880 

T=<TM+TSTAGE>/’TBURN  CLSOOSSu 

BHOW=BFUN<T)  CLSOOSOO 

SMAS< IB  >=U*<  BNOU-BTHEN  >  CLSOOSI 0 

6THEN=BNGW  CLS00920 

IF  <ITYPE.E£ii.4>  SMAS<  IB  )=SMAS<  IB  TBURN  CLS0093o 

CfH.*  COMPUTE  VOLUME  AT  TIME  TO  OF  FIRST  PUFF  CLS00940 

120  IF  <ITYPE.E0.3>  GOTO  130  CLS00950 

IF  <  1TYPE.EG!.4>  GOTO  140  CLS00960 

C***  PUP.  RP  OR  WP  WICKS/WEDGES  CLOUD  CLS00970 

VOL  =  0,25*<4,>*'PI/3.  )*X>fcYi>Z  CLS00980 

GOTO  200  CLS00990 

130  IF  <TO.LE.TLIM>  GOTO  140  CLS01000 

C***  POST  RISE  REGION  HC  CONE.  CLS01010 

VOL=0.5*<  PI/’S.  ■jt.XLIMfVLIMAZLIM  CLS01  020 

O'***  POST-RISE  FRUSTRUM  OF  APPROXIMATED  ELLIPTIC  CONE,  CLS01030 

X2PR0J=Z*<X-XLIMV<Z-2LIM>  CLS01 040 

VFRUST=0.5’*<PI/^3.  )♦< XZPRO J-K  Y*Z-YLIM*2LIM >+< X-XLIM )#YHM>»ZLIM >  CLS01  050 

VOL=VOL+VFRUST  CLS01060 

GOTO  200  CLS0I070 

Cff-f  HC  BEFORE  THE  END  OF  EXOTHERMIC  RISE  AND  FOG  OIL  CASE  CLS01080 

140  VOL-0. 5*< PI/3,  >*X*y*2  CLS01090 

€>***  STORE  PATH  LENGTH/VOLUME  RATIO  AT  TIME  TO  FOR  FIRST  EXPANDING  CLSOIIOO 

C  UNIFORM  AND  GAUSSIAN  PUFF  CONTRIBUTION.  CLS01110 

200  IF  < ITyPE.NE.4i  PV=,25*<PATHL/V0L)+.75*CLGAUS  CLS01120 

IF  <ITYPE.EQ.4)  PV-PATHL/VOL  CLS01130 

IF  <PV,LE. 0, , AND, START. EQ. 0. )  RETURN  CLS01140 

IF  <PV,GT, 0. .AND, START. EQ. 0,  )  START*TO  CLS01150 

IF  < IPL.GE.MAXS)  GOTO  300  CLS01160 

IPL=IPL+1  CLS01170 

IF  < IPL .EO.MAXS)  WRITE  <IOOUT,910)  TO, IPL  CLS01180 

910  FORMAT< 1X,58Hi"*f  WARNING  -  IN  SMOKE,  MAX.  STORAGE  FOR  CLOUD  VOLUMECLS 0 1 1 9 0 

*S  OF  ,I5,34H  SEC,  IS  FULL.  COMPUTATION  TIME  »  ,F6,0,5H  SEC./'  CLS01200 

*15X,40HACCURACY  BEYOND  THIS  POINT  DECREASES  )  CLS01210 

PV0L<1PL)»PV  CLS01220 

C-***  SUM  CL  FOR  PUFFS  CLS01230 

300  IF  <NRAT,EQ,1)  GOTO  400  CLS01240 

LMIN=MAX0< 1 ,< IPL-I8+1 >>  CLS0125C 

IF  < IPL.LT.LMIN)  RETURN  CLS01260 

N»0  CLS01270 

DO  320  J-LMIN,IPL  CLS01280 

K=IPL-J+1  CLS01290 

CDEL=SMAS<K>*PVOL< J)  CLS0t300 

CL-CL+CDEL  CLS01310 

N»N+1  CLS01320 

IF  <N,LT,120>  GOTO  320  CLS01330 

IF  <ABS<CDEL>.LT.1 .E-5>  RETURN  CLS01340 

320  CONTINUE  CLS01350 

RETURN  CLS01360 

Cii**  FAST  COMPUTATION  FOR  CONSTANT  BURN  RATES  CLS01370 

400  TOTPV-TOTPV+PVOL< IPL >  CLS01380 

C  INDEX  OF  LAST  PUFF  EMITTED  CLS01390 

IF  < IPL,LT.MAXS>  KSUB-IPL-IB  CLSOf400 
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C  KEEP  REMOVING  Li^ST  PUFF  IF  POSSIBLE 
IF  < IPL.EQ.MAXS)  KSUB=KSUB+t 
IF  CKSUB.GT. IPL>  KSUB*IPL 

C  ONLY  REMOVE  PUFFS  AFTER  BURN  HAS  STOPPED  < IE  LAST  PUFF  OUT> 
IF  <KSUB.GT.O)  TOTPV-TOTPV-PVOL<KSUB> 

CL»TOTPVKBR 

RETURN 

END 


CLSOMt  0 
CLS01 420 
CLSOt  430 
CLS01440 
CLS01 450 
CLS0t460 
CLS01470 
CLS01480 
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C*'*'*‘i* 

50 

C’*** 

O’*** 

C’*** 


SUBROUTINE  SC0NST<  ICAT.UU,  ITYPE,  FW,EFF,TBRN,NPl(IP,  AIRT,  TGRAD,  Cl  ,C2,SC00001  0 
h  C3,  XN,XLII1,YLIM,ZL1I1,HLIM,TLIM,XS,CNEUT,PCNT,W>  SC000020 
COMMON  /CONST.^P1,PI2,PIRAD,T«OPI,TORRMB,CDECK  SC000030 
COMMON  /’lOUNlTXIOIN, lOOUT, IPHFUH , LOUNIT , NDIRTU , NCLl MT , KSTOR . NPLOTUSCOO 004 0 

SC000050 

SMOKE  MODEL  PARAMETERS  FOR  CLOUD  DIMENSIONS  SC000060 
THIS  SUBROUTINE  CALCULATES  THE  PARAMETERS  FOR  THE  CLOUD  WIDTH  AND  SCuOOOFO 
CLOUD  HEIGHT< MOMENTUM)  AS  A  FUNCTION  OF  PASOUILL  CATEGORY  AND  THE  SCOOOOBO 


HEAT  RISE  PARAMETER  FOR  THE  HEIGHT< EXOTHERMIC ) .  HEAT  RISE  IS 
TERMINATED  AS  A  FUNCTION  OF  ATMOSHERIC  STABILITY 


INPUT; 


OUTPUTS 


ICAT 

Ukl 

ITVPE 

FW 

EFF 

XN 

TBRN 

NPWP 


AIRT 

TGRAD 


Cl 

C2 

C3 

XLIM 


PASQUILL  CATEGORY 

1-A,  2-B,  3-C.  4-D,  5-E.  6-F 
WIND  VELOCITY  < MXS ) 

TYPE  OF  SMOKE.  1=WP,  2=PWP  OR  WP 


FILL  WEIGHT  _ 

EFFICIENCY  < PERCENT) 
NUMBER  OF  MUNITIONS 


ICK/WEDCE, 

3=HC,  4=F0G  OIL,  5=RP 
<LBS> 


SCO 00 09 6 
SCOOOl 00 
SCOOOl 1 0 
3C000120 
SCOO0t3O 
SCOOOl 40 
SC000150 
SC000160 
SCOOOl 70 
SCO  0  0180 


BURN  TIME  FOR  THIS  STAGE  COR  ENTIRE  MUNI TION )SEC ,  SCOOOiSO 
FLAG  FOR  LONG-BURN  PHOSPHORUS,  IF  NON-ZERO,  THEN  SC000200 
BURNS  ARE  IN  25  PERCENT  STAGES  TO  ALLOW  SEPARATE  SC00021 0 

BUOYANCIES  FOR  EACH.  SC000220 

SURFACE  AIR  TEMPERATURE  < DEG  C>  SC000230 

VERT  TEMP  GRADIENT  <C  DEG , XM )  USED  ONLY  FOR  80000240 

CATAGORIES  E,F  <IE.  5,6)  IN  WHICH  IT  MUST  SC000250 

BE  POSITIVE,  SC000260 

EQUATION  PARAMETER  FOR  CLOUD  WIDTH  Y=9,i+Cl*X  SC000270 
PARAMETER  FOR  HEIGHT  < MOM )  Z-2,73+C2*X  SC000260 

PARAMETER  FOR  HEIGHT  <EXO)  Z»2 . 73+C2'*X+C3*X'*>«'2X3  SC000290 
CLOUD  LENGTH  ALONG  WIND  DIRECTION  <M>  8C000300 

AT  RISE  TERMINATION.  SC000310 

YLIM  CLOUD  BASE  HALF-WIDTH  PERP .  WIND  DIRECTION  <M)  SC000320 

AT  RISE  TERMINATION.  SC000330 

ZLIM  TOTAL  CLOUD  HEIGHT  AT  TERMINATION  OF  HEAT  RISE.  SC000340 

HLIM  TOTAL  ADDED  RISE  AT  TERMINATION  OF  HEAT  RISE.  SC000350 

TLIM  TIME  OF  TERMINATION  OF  HEAT  RISE  SC000360 

XS  TERM  FOR  CALCULATION  OF  HEIGHT  FOR  NEUTRAL  CONDITISC000370 

CNEUT  TERM  FOR  CALCULATION  OF  HEIGHT  FOR  NEUTRAL  CONDI T I  SCO  0038 0 

SCO 00390 

DIMENSION  Cl (<6),C22<6)  SCu00400 

DATA  Cl 1/,419, .328, ,238, .2, . 18, . 146X  SC00041 0 

DATA  C22/ .  137,  .  1  1  ,  .  073,  .  066,  .  055,  .  046/'  SC000420 

TLIM=600.  SC000430 

XS=0,0  SCO 00440 

CNEUT=0.0  SC000450 

XLIM=>0,  SC000460 

YLIM=0,  SC00047U 

ZLIM=0,  SC000480 

HLIM=1.0  SC000490 

ERROR  CONDITION  SC000500 

IF< ICAT.LT. 1  .OR. ICAT.CT.6)  WRITE< 100UT,50  )  SC000510 

FORMATCIH  , 62HERR0R  IN  SUBROUTINE  SCONST .  PASQUILL  CATEGORY  IS  NOTSC000520 


1  ^prPPT^m  P  'i 

IF  < ICAT.LT, 1 , OR. ICAT. GT. 6)  RETURN 

SELECTION  CF  CLOUD  WIDTH  COEFFICIENT  AS  A  FUNCTION  OF  PASQUILL 
CATEGORY. 

Cl  =  Ct1< ICAT  > 

SELECTION  OF  CLOUD  HEIGHT<MOM)  COEFFICIENT  AS  A  FUNCTION  OF 
PASQUILL  CATEGORY. 

C2  *  C22<ICAT) 

IF< ICAT.GT. 1 )GO  TO  1 
IF<UW.GT.2. 0)GO  TO  1 
C2=0. 15 

IF<UW.GT. 1 .5)C0  TO  1 
C2-0. 16 

1F<UW,GT.1 .0)GO  TO  1 
C2=>0.25 

1F<UW.GT. 0.5>GO  TO  1 
C2“0 . 39 
I  CONTINUE 


SC000530 
SC000540 
SC000550 
SC000560 
SC000570 
SC000580 
SC000590 
SC000600 
SC00061 0 
SC000620 
SC000630 
SC000640 
SC000650 
SCO 00660 
SC000670 
SC000680 
3C000690 
SC000700 


\ 
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AD-A114  417  ARMY  ELECTRONICS  RCSCARCN  ANO  DEVELOPNCNT  COMMAND  VS— ETC  F/r  >i/1 

PROGRAM  LISTINGS  FOR  EOSAEL  OO-S  ANO  ANCILLARY  COOES  AOAUS  AND  — ETC(li) 
FEB  82  R  0  STEINhOFf 

UNCLASSIFIED  ERAOCOM/ASL-TR-01O7-v2-SU  MI 


i 

i 


120  TB=TBRN  SC000710 

IF  < ITYPE.EQ, 1 .AHD.TBRN.GT.1 . )  TB-1 ,  SC000720 

IF  <NPUP.NE.O)  TB=TB/’PCNT  SCu00730 

C***  IF  NON-EXOTHERMIC,  RETURN.  $0000740 

IF  <ITYPE.EQ.4>  RETURN  SC000750 

EM=800.0  SC000760 

IF< ITYPE.Ea.3>EM=500. 0  SC000770 

IF< ITYPE.EQ,5)EM=660.  SC000780 

F=0. 00001>f3.59*453.59fEM>»FU'*XN*<EFF/'1  00.  ^>/^B  $0000790 

C***  OALCULRTION  OF  CLOUD  HEIGHT  < EXO )  COEFFICIENT  FOR  UNSTABLE  ATM.  8C000800 

Cf**  CONDITIONS  <AjB,C>  $0000810 

C3=1  .6/’UU*<F**.3333>  SC000820 

IF<:  ITVPE  .  EQ  .  3  )  GO  TO  200  $0000830 

IF< ICAT.EQ.4)  GO  TO  131  SCO00S40 

IFc ICAT . GT . 4 >  GO  TO  141  $0000850 

TLIM=0.0  $0000880 

Off*  DETERMINE  TIME  AND  TOTAL  CLOUD  HEIGHT  AT  TERMINATION  OF  HEAT  R ISE . $0000870 

123  TLIM=TLIM+2.  SC0008SO 

X=Uuj>t>TLlM  $0000890 

Y=*t:9. 1+C1*X)/'2.  $0000900 

V=  .  75*<  2. •*'3. 14159)*>f1 , 5>»<  YX2 . 1 5  >*'*'2'*<  2 . 73+C3>tiX  >X4 .3  $000091  0 

C=W/<V<*TB;  $000  0920 

IFC 0 . GT . 0 . 1 1  )  GO  TO  123  $0000930 

HLIM=C3X'X*'*.667  $0000940 

RETURN  $0000950 

C-***  CALCULATION  OF  CLOUD  HEIGHT  <EXO>  COEFFICIENTS  FOR  NEUTRAL  ATM.  SC000960 

C***  CONDITIONS  <0).  $0000970 

131  XS=1 0. 0*F*f0,4  SC000980 

CNEUT-1  ■6*<Ft"*.3333)fXS**0.667XUW  $0000990 

RETURN  $0001000 

141  CONTINUE  $0001010 

C***  CALCULATION  OF  CLOUD  HEIGHT  <EXO>  COEFFICIENT  AND  TOTAL  CLOUD  SC001020 

C-***  HEIGHT  AT  TERMINATION  OF  HEAT  RISE  FOR  STABLE  ATM.  C0NDIT10NS<E,F >80001 030 

SBAR=9,8/'<AIRT4273. 0>#<TGRAD+0.0098>  SC001  040 

HLiM=1  .4>*-<F.-'<UU*SBAR  >>•■«•.  333  $0001050 

RETURN  $0001080 

0  •*■■*•*■  CALCULATE  PARAMETERS  FOR  HO  10  SEC,  RISE  TIME,  SC001070 

200  TLIM=1 0.  $0001 080 

XLIM=TLIM>*Ulil  $0001  090 

YHM=<9. 1+C1*XLIM>/'2,  SC001100 

ZLIM»2.73+C2*XLIM  $0001110 

IF  <ICAT.EQ.4>  GOTO  231  SC001120 

HLIM=C3*XLIMt>».667  $0001130 

ZLIM=ZLIM+HLIM  SC001t40 

IF  <ICAT.LT.5>  RETURN  $0001150 

SBAR*9,8/'<  AIRT+273.  )•<  TGRAD+ 0 . 0098  >  $0001160 

HTEST=1  .4>*<FX<UW>»SBAR  )>>*»,  333  $0001170 

IF  <HLIM.LE,HTEST>  RETURN  $0001180 

Of**  IF  UNSTABLE  ATMOSPHERE  REACHES  MAX.  BEFORE  10  SEC.  COMPUTE  $0001 190 

Cf>*"»  TLIM.  $0001200 

XLIM=<HTE$TXC3)*k1 .5  $0001210 

TLIMaXLIMXUW  SC001220 

YLIM=<9. 1-*-C1*XLIH>X2.  $0001230 

HHM=HTEST  $0001240 

ZLIM=2.73+C2*XLIM+HLIM  SC001250 

RETURN  $0001260 

231  X3"T  0 . 0'*F**0 . 4  $0001270 

CNEUT»C3*<XS>*<*,667>  SC001280 

HL  IM=CNEUT»<  0,4+0. 64«<  XL IM/XS  >+2 , 2*<  XL IMXXS  )i"*2  >/  SCO0 1 290 

+< 1 .+0.8+XLIMXXS>++2  SC001300 

2LIM=ZLIM+HLIM  SC001310 

RETURN  SC001320 

END  $0001330 
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SUBROUTINE  SMASSP< XN, EFF, FW. RELHUM, W, ITYPE, YF >  SMAOOOlO 

COHMON  /'lOUNIT/'IOIN,  IOOui>  I^HFUH,  LOUNIT,  NOIRTU ,  NCLl MT ,  KSTOR ,  NPLOTUSMA 00020 

SKR00030 


SMOKE  MODEL  _ 

THIS  SUBROUTINE  CALCULATES  THE  SMOKE 
MUNITIONS  AT  THE  SAME  POINT  AND  SAME 
INPUTS  ITYPE  SMOKE  TYPE 

1  WHITE  PHOSPHOROUS 

2  PLASTICIZED  WHITE 

3  HC 

4  FOG  OIL 

5  RED  PHOSPHORUS 

XH  NUMBER  OF  MUNITIONS  AT 


90 

50 

lot 


t  02 


C*** 
103 
1 1  0 


MASS  PRODUCED  BY  XN 
TIME. 


PHOSPHORUS  OR  UP  UICK  WEDGE 


THIS  POINT  AND  TIME. 


RELHUM  RELATIVE  HUMIDITY  < PERCENT >. 

EFF  MUNITION  EFFICIENCY  <PEkCENTj 

FU  FILL  WEIGHT  <LB3  FOR  TYPES  1-3,  GAL/HR  FOR  TYPE  4> 
U  SMOKE  MASS  PRODUCED  FOR  XN  MUNITIONS. 

G  FOR  TYPES  1-3  AND  5,  G/S  FOR  TYPE  4 
YF  OPTIONAL  USER  SUPPLIED  YIELD  FACTOR 


IRiTYPE.LT.1  .0R.ITYPE.GT.5)  GO^TO  90 
GO  TO  < 1 01 , 1 01 , 1 02, 1 03> 1 01 ), ITYPE 

FORMAT<°A26h'^ERROR^IN  SMASSP:  SMOKE  TYPE  ,14,1  OH  UNDEFINED  > 
RETURN 

Y=.028i<RELHUM+3.4 
C0NVER=453.592 
GO  TO  110 

Y*1 .17  ♦. 014*RELHUM 
C0NVER=453.592 

FOR^FOG^OIL,  W  IS  A  RATE,  WHERE  FW  IS  IN  GAL/HR  AND  .93 
CONVERTS  TO  G7S . 

Y=1  .  0 

CONVER-0.93 

IF  <YF.HE. 0. )  Y-YF 

YF=Y 

«aXH*YfFW-*CONVER*<  EFF71  00 , 0  > 

RETURN 

END 


SMA00040 
SMA00050 
SMA00060 
SHA00070 
SMAOOOdO 
SMA0G090 
SMA001 00 
SMA001 1 0 
SMA00120 
SMA00130 
SMA00140 
SMA00150 
8MA00160 
SMA00170 
SMA00180 
SMA00190 
SHA00200 
SHA0021 0 
SMA00220 
SMA00230 
SMA 00240 
SMA00250 
SMA00260 
SHA00270 
SHA00280 
SHA00290 
SMA 003 00 
SMA0031 0 
SMA 00320 
SMA00330 
8nA00340 
SMA00350 
SMA003S0 
SMA00370 
SMA00380 
SMA 00390 
SHA00400 
SMA0041 0 
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SUBROUTINE  3ThANS< CL , SMTRAN, ITVPE.EXTC, ICALL) 


3TR000<  0 
STR00020 
STR0005O 
STR00040 
3TR00050 


SMOKE  MODEL  CLOUD  TRANSMISSION  STR00040 

THIS  SUBROUTINE  CALCULATES  TRANSMISSION  IN  7  SPECTRAL  REGIONS  STR00050 
<0.4-0.7,0.7-1.2,1.06,3.0-5.0,8.0-12.0,10.6  MICROMETERS  AND  94.GHZ>  STR00060 
FOR  A  GIVEN  SMOKE  TYPE  AND  CONCENTRATION  LENGTH  3TR00070 

INPUTS  ITYPE  SMOKE  TYPE  STR00080 

1  WHITE  PHOSPHOROUS  STROOOSu 

2  PLASTICIZED  WHITE  PHOSPHORUS,  UP  WICK  WEDGE  STR00100 

3  HC  STROOnO 

4  FOG  OIL  STR00120 

5  RED  PHOSPHORUS  STR00130 

^  ^  STR00140 


CL 

ICALL 


COMPUTED  CL  IN  <G/'M**2> 


=  0  SETS  UP  EXTC  ARRAY  USED  FOR  COMPUTATIONS  ANDSTR00150 


ALLOWS  USER  TO  OVER-RIDE  DEFAULT  ALPHAS. 
1  EXECUTES  TRANSMISSION  CALCULATION. 


OUTPUTS  SMTRAN  TRANSMISSION  THROUGH  SMOKE  <DECIMAL> 

EXTC  ARRAY  OF  EXTINCTION  COEFF .  ACTUALLY  USED 
IN  TRANSMISSION  CALCULATION.  EXTC<8>  IS 
USED  AS  A  FLAG  FOR  ICALL-0  REPLACEMENT. 

IF  EXTC<8>=ITYPE,  HO  CHANCES  ARE  MADE  IN  EXTC  ARRAY  IE. 

ALPHA  VALUES  DO  NOT  REPLACE  EXTC  VALUES. 

IF  EXTC<8)=*0.  ,  ONLY  THOSE  VALUES  IN  EXTC  WHICH  ARE 

ZERO  ARE  REPLACED  BY  THE  STORED  VALUES  IN 
ALPHA  < ITYPE  COLUMN). 

IF  EXTC<8)  IS  NOT  0.  OR  ITYPE,  THEN  ALL  EXTC  VALUES 


STR001 60 
STR001 70 
STR00180 
STR00190 
STR0C200 
STROOZt  0 
STR00220 
3TR0023U 
3TR00240 
STR00250 
STR 00260 
STR00270 
STR 00280 
STR002SO 


ARE  REPLACED  BY  CORRESPONDING  ALPHA  VALUES  ANDSTR00300 
EXTC<8)  IS  SET  TO  ITYPE.  STR00310 

STR00320 

DIMENSION  ALPHA<7,5),SMTRAN<7>,EXTC<8>  STR00330 

DATA  ALPHA  /4 . 304, 2 . 1 66, 1 . 541 , 0 . 350 , 0 . 338, 0 . 364 , 0 . 00 1 ,  STR00340 

<*  4.304,2.  166,  1  .541 , 0.350,  0.338,  0.364,  0, 001 ,  STR00350 

*  4.579,2.186,2.040,0.190,0.052,0.051,0.001,  STR00360 

•*  6.851,4.592,3.497,0.245,0.020,0.018,0.001,  STR00370 

f  4.304,2.166,1.541,0.350,0.338,0.364,0.001/  STR00380 

TRANSMISSION  CALCULATED  BY  BEER'S  LAW  APPROXIMATION  STR00390 

C***  IF  ICALL-0,  EXTC  ARRAY  IS  FORMED  OR  MODIFIED...  STR00400 

IF  < ICALL. NE.O)  GOTO  20  STR00410 

IF  <EXTC<8).EQ.FL0AT< ITYPE))  GOTO  18  8TR00420 

IF  <EXTC<8).EQ. 0.  )  GOTO  15  STR00430 

DO  13  0-1,7  STR00440 

13  EXTC<  J)=0.  STR00450 

15  EXTC<8)-FL0AT< ITYPE)  STR00460 

DO  17  J»1,7  STR00470 

IF  <EXTC< J>.EQ. 0.  )  EXTC< J)-ALPHA< J, ITYPE)  STR00480 

17  CONTINUE  STR00490 

18  RETURN  STR00500 

C***  FOR  ICALL  NON-ZERO,  COMPUTE  TRANSMISSION  USING  EXTC  VALUES,  STR00510 

20  DO  30  1-1,7  STR00520 

SMTRAN< I  )-EXP< -EXTC< I )fCL  )  STR00530 

30  CONTINUE  STR00540 

RETURN  3TR00550 

END  STR00560 
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SUBROUTINE  WGGEOM< ICALL, CLGAUS. ITYPE,XPPi , VPPl ,2PP1 . XPP2.YPP2. 

WGG0001 0 

1 

1 

) 

1ZPP2,C1 .C2,C3.T0.UW. ICAT,HL1M. TL I M, CNEUT, XS, PATHL , X, Y . 2, KLIM, 

WGG00020 

1 

2YLIM.ZLIM) 

WGG00030 

C  NOTE;  THE  FOLLOWING  COHMON  BLOCK  ALLOWS  MUNITION  BURN  DURATION 

UGG00050 

C 

AND  OBSCURATION  PERIODS  UP  TO  16.0  MINUTES  <960  SEO 

WGG00060 

C 

UGG00070 

COMMON  /M05/  SMAS< 960  PVOL< 960 >, CLTOT< 960 >, SMTRAN< 7  ) , R1 < 9 >. 

WGG00080 

*EXTC<  8  ),  2L<  2  >,  XL<2  >,  YL<  2  ).  XINT<  2  >,  YINT<  2  ),  2INT<  2  >,  IFLAG<  2  > 

WGG00090 

COMMON  /CONSTZP 1 , P 12 , P I RAO , TWOP I , TORRMB . CDEGK 

WGG001 00 

DATA  MAXS  /AeOX 

WGC001 1 0 

C 

WGG00120 

C 

NOTE:  TO  CHANGE  LENGTH  OF  BURN  OR  OBSCURATION.  RESET 

UGG  00130 

C 

MAXS  AND  REDIMENSION  SMAS.  PVOL  AND  CLTOT  ARRAYS 

WGG00140 

C 

WGG00150 

c 

SMOKE  MODEL  GEOMETRY 

WGGC01 60 

c 

INPLi  1  : 

WGGuOi 70 

c 

ITYPE  =  SMOKE  TYPE  CODE 

WGG001 30 

c 

XPP1 , YPP1 .2PP1  =  OBSERVER  IN  MUNITION  CENTERED  COORDINATES 

WGG00190 

c 

YPP1 . YPP2,2PP2  -  TARGET  IN  MUNITION  CENTERED  COORD.  <X  AXIS  ALONG 

WGG00200 

c 

WIND  VECTOR.  ) 

WGG0021 0 

c 

C1.C2.C3  -  CLOUD  GROWTH  PARAMETERS  < SEE  PROGRAM  SCONST > 

WCG00220 

c 

TO  =  TIME  SINCE  DETONATION  < SECONDS) 

WGG00230 

c 

UW  =  WIND  SPEED  < METERS/SECOND > 

WGG00240 

c 

ICAT=PASOUILL  CATEGORY 

WGG00250 

c 

HLIM.TLIM.CNEUT.XS-  EXOTHERMIC  RISE  PARAMETERS 

WGG00260 

c 

ICALL  ■  FLAG  SET  BY  USER  TO  0  FOR  1ST  CALL.  RESET  BY  PROGRAM 

WGG00270 

c 

TO  1  THEREAFTER. 

UGG00260 

c 

OUTPUT: 

WGG00290 

1 

c 

X  =  CLOUD  LENGTH  < METERS) 

UGG00300 

c 

Y  =  CLOUD  HALF-WIDTH  < METERS) 

WGG0031 0 

c 

2  =  CLOUD  HEIGHT  (METERS) 

WGG00320 

c 

PATHL  =  PATHLENGTH  OF  LOS  THROUGH  SMOKE  CLOUD 

WGG00330 

c 

UGG00340 

> 

c 

SUBROUTINES  CALLED. . .  DIRECTLY:  XYZINT,  GPUFF,  INDIRECTLY:  QROOT 

WGG00350 

c 

WGG 00360 

* 

c  •***  TRANSLATION  TO  PLACE  MUNITION  AT  <0,0,0> 

WGG00370 

IF  < ICALL. NE. 0)  GOTO  1 0 

WGG00380 

ICALL=1 

WGG00390 

KCALL-O 

WGG 004 00 

C***  CALCULATE  LEADING  EDGE  LOCATION  AT  TO. 

WGG0041 0 

1  0 

A-UW^TO 

WGG00420 

B*<9. 1/2. 0)+A>«-C1/2. 

WGG00430 

IF  < ITYPE.E0.3.0R. ITYPE.EQ.4)  GOTO  33 

WGG00440 

C***  UP/PUP/RP  COMPUTATION. 

WGG00450 

GO  TO  < 1 1 , 1 1 . 1 1 ,21 ,31 ,31  ), ICAT 

WGG00460 

1  1 

CONTINUE 

UGG00470 

C-2 . 73+C2-»A+C3*A*f  .  667 

WGG00480 

CLIM-2.73+C2*A+HLIM 

UGG00490 

IF<  TO . GT . TL IM . AND . C . GT . CLIM )C-CLIM 

WGG00500 

GO  TO  41 

UGG0051 0 

21 

CONTINUE 

WGG 00520 

C“2 . 73+C2+A 

UGG00530 

IF  (A.LE.XS)  C«*C+C3i*A«'*,667 

WGG00540 

IF  (A.GT.XS)  C*=C+CNEUT*<  0.4+0. 64t«<A/XS)*2.2»<A/XS>*>i>2)/ 

WGG00550 

1(1. 0+0,8*<A/XS))*+2 

WGG 00560 

GO  TO  41 

WGG00570 

31 

CONTINUE 

WGG00580 

C»2 . 73+C2*A+C3*A>»*0 . 667 

WGG00590 

CL I M=2 . 73+C2*A+HL I M 

WGG00600 

IF<C.GT.CLIM>C-CLIM 

WGG0061 0 

•* 

GOTO  41 

WGG00620 

C***  HC,  FOG  OIL  COMPUTATION. 

WGG 00630 

33  C-2 , 73+C20A 

WGG 00640 

IF  < ITYPE.EQ.4)  GOTO  41 

WGG00650 

IF  (TO.LT.TLIM)  GOTO  33 

UGG00660 

C-C+HLIM 

UGG00670 

GOTO  41 

UGG00680 

35  IF  <  ICAT.NE.4.0R.A.LE.XS>C-C+C3'»A<»4>0.667 

WGG00690 

IF  <ICAT.EQ.4  .AND.  A.GT.XS) 

WGG00700 

too 

3 

1 

t02 


SUBROUTINE  XY21NT< NCODE, XL , VL , ZL, XO, VO, 20, XINT, VINT, ZINT , IFLhG  )  XVZOOul 0 
D1I1EHSI0H  XL<2>,VL<2>,2L<2  ),XINT<2>,YINT<2>,Z1NT<;2),  IFLflG<2>  XVZ0  0  020 

DIMENSION  DIST<2>,TEST<2)  XVZ00030 

C«>|i«>ii4iSUBR0UTINE  XVZINT***>*>*  XVZ00040 

C».**>**PURP0SE :  XV200050 

C  TO  FIND  THE  X,V,2  INTERCEPTS  OF  A  TARGET-OBSERVER  LINE  OF  SICHTXVZ00060 

C  WITH  A  SMOKE  CLOUD  DESCRIBED  BY;  XVZ00070 

C  NCODE  =  1  A  HALF  ELLIPTIC  CONE  WITH  APEX  AT  THE  ORIGIN  XVZ00080 

C  AND  LEADING  EDGE  TRUNCATION  BV  THE  X=X0  PLANE  XVZOOCSO 

C  AND  BOTTOM  EDGE  TRUNCATION  BV  THE  Z-0  PLANE,  XVZ00100 

C  NCODE  =  2  A  QUARTER  ELLIPSOID  WITH  APEX  XVZuultO 

C  AT  THE  ORIGIN  AND  WITH  LEADING  EDGE  TRUNCATED  BV  XV200120 

C  THE  X=XO  AND  BOTTOM  EDGE  TRUNCATED  BV  THE  2=0  PLANE,  XV200130 

Ct*****IHPUT !  XV200140 

C  XL<2>,VLc2>,ZL<2 j  =  X,V,2  COORDINATES  OF  TUO  POINTS  THROUGH  XV20015C 

C  WHICH  THE  LOS  PASSES<1E,  TARGET  AND  OBSERVER  COORDINATES).  XV200160 

C  X0,V0,20  =  LENGTH  OF  SEMI-AXES  OF  ELLIPSOID.  XV200170 

C**ii.,i->*OUTPUT !  XV200180 

C  XINT<2), VINT<2),ZINT<2)  =  X,V,2  COORDINATES  OF  THE  INTERCEPTS  XVZuOtSO 

C  OF  THE  LOS  WITH  THE  ELLIPSOID.  XV200200 

C  IFLAG<2)  -  INTERCEPT  TYPE  FOR  EACH  INTERCEPT  COORD  i  XY20Ci210 

C  =  0  NO  INTERCEPT  XYZ00220 

C  =  1  INTERIOR  TO  VOLUME  XYZ0023U 

C  =  2  ON  CONICAL  OR  ELLIPTICAL  SURFACE  XVZ00240 

C  =  3  ON  LEADING  EDGE  OF  SURFACE  XV20u250 

C****>*MATHEMATICAL  APPROACH:  XV200260 

C  THE  EQUATION  OF  THE  ELLIPSOID  CAN  BE  WRITTEN  AS:  XVZ00270 

C  <<X-X0>7X0)**2  ♦  <Y/V0>**2  +<2X20  >■••2  =  1  XV200280 

C  AND  THE  EQUATION  OF  THE  LOS  CAN  BE  WRITTEN  AS:  XY200290 

C  <X-XL1 )X<XL2-XL1  )  =  < V-VL1  )X< VL2-VL1 >  »  < 2-ZL 1 >X< ZL2-ZL 1 )  XV200300 

C  THE  TWO  EQUATIONS  ARE  COMBINED  TO  FORM  A  QUADRATIC  EQUATION  XV200310 

C  WHICH  IS  SOLVED  TO  GIVE  THE  INTERCEPTS,  XV200320 

C  SIMILARLY  FOR  THE  LOS  EQUATIONS  AND  ELLIPTIC  CONE  :  XV200330 

C  <ZX20>*^2  +  <VXV0)*>*2  -  <XXX0>'*.*2  «  0  XYZ00340 

C,t!iii**i*SPECIAL  NOTES  XV200350 


C  <1>  WHEN  TWO  OR  MORE  COORDINATES  ARE  THE  SAME,  SPECIAL  CASES  ARE 
C  FORMED  WHICH  MUST  BE  DEALT  WITH  SEPARATELY  BECAUSE  OF 

C  SINGULARITIES  IN  THE  LOS  EQUATION. 

C  <2>  WHEN  TARGET  ANDXOR  OBSERVER  ARE  INSIDE  THE  CLOUD  INTERCEPTS 
C  ARE  TAKEN  AS  THE  TARGET  ANOXOR  OBSERVER  COORDINATES. 

C  <3)  PROPER  ACCOUNT  IS  TAKEN  FOR  A  LOS  INTERCEPTING  THE  CLOUD 
C  LEADING  EDGE  BUT . 

C  <4>  ALL  COORDINATES  MUST  BE  ABOVE  THE  2-0  PLANE  <IE.  ABOVE  THE 
C  SURFACE.) 

C  SUBROUTINE  CALLED...  QROOT 
C+****INITIALIZE  PROGRAM  VARIABLES 
H=0 
12=0 
lNT-0 
LEAD=0 
ISURF=0 
K1=0 
K2-0 
K3=0 
K4-0 

TEST< i  )-0. 0 
TEST<2>=0. 0 
TE3T3-0. 0 
TEST4-0. 0 
OIST< i >-0. 0 
DIST<2>»0. 0 
DELX»XL<2)-XL< 1 ) 

DELV-YL<2)-YL< 1 ) 

DELZ-ZL<2>-ZL< 1  ) 

IFLAC< 1  )-0 
IFLAG<2)=0 

C***  REJECT  IMMEDIATELY  IF  BOTH  TGTX0B8  BELOW  2-0. 

IF  <2L< 1 >.LT. 0. . AND.2L<2),LT. 0. )  GOTO  800 
C.***.i.*DETERMINE  SPECIAL  CASES  FOR  LOS 


XYZ00080 
XVZ00090 
XVZ001 00 
XVZOol 1 0 
XV200120 
XV200130 
XV200140 
XY20015C 
XV200160 
XY200170 
XY200180 
XYZOOtSO 
XY200200 
XY20CI21  0 
XYZ00220 
XYZ0023U 
XVZ00240 
XV20U250 
XV200260 
XVZ00270 
XV2 00280 
XY200290 
XV200300 
XV20031 0 
XV200320 
XV200330 
XY200340 
XV200350 
XVZ 00360 
XY200370 
XY200380 
XVZ00390 
XY200400 
XV20041 0 
XV200420 
XYZ00430 
XVZ00440 
XY200450 
XY200460 
XVZ00470 
XV200480 
XV200490 
XV200500 
XV20051 0 
XVZ00520 
XVZ00530 
XVZ 00540 
XVZ00550 
XV200560 
XY200570 
XVZ00580 
XYZ00590 
XVZ00600 
XY20061 0 
XVZ00620 
XY200630 
XY200640 
XY200650 
XVZ00660 
XY200670 
XYZ00680 
XV200690 
XV200700 


t03 


J 


ICASE-I 

IF  <ABS<DELX>.GT.< . 01 *ABS< DELV > > . AND . 

*  ABS( DELX  > . GT . ABS< . 0 1 *ABS<  DELZ  > ) >  GOTO 
1CA3E=2 

IF  <hBS<DELV>.GT.<  . 0i»ABS<DEL2>i>  GOTO  12 
ICASE=.3 

IF  <DELZ.GT.1 . E-2.0R.DEL2.lt. -1 .E-2>  GOTO 
ICASE=>4 
12  CONTINUE 

C***»*DEFAtJLT  SPECIAL  CASE  OF  OBS-TAR  COINCIDENT 
IF<ICASE.NE.4)G0  TO  14 
GO  TO  800 
14  CONTINUE 

C***M.%SEI_yP  TEST  TO_DETERMINE 
C 


12 


12 


<  <  XL<  I  )-X0  )/'X0  )**2  +  <  YL<  I  >/YC>*>*2  ♦ 


0  >GO  TO  2 
,  OR . 2L< 1 ) . LT . 0 . 


>  GOTO  2 


.  __  _  _  IF  TARGET  AND/OR  OBSERVER  ARE  IN  THE 

INTERIOR  OF  THE  CLOUD 
DO  1  1=1,2 

IF  (  NCO''>E  .  EQ  .  2  )  TEST<  I  >• 
k<ZL<  1  V20>*»2-1  . 

IF  <NCODE.EQ.l)  TEST<  I  >=<  YL<  I  >/Y0  )>**2  ♦  <  2L<  I  >/Z0  )*>*2 
*(  XL<  I  >/X0  >*>*2 
1  CONTINUE 

IF<TEST< 1 >.GT. 0. 

IF  <  xn:  O.LT.u.  _ 

IF  <:XL<  1  >.GT.X0>  GOTO  2 
IF  <XL< 1  ).EO.XO>  K1  =  1 

IF  <TEST<1  ).EQ.O. .OR.ZL<1 ).EQ.O. >  K3=l 
11  =  1 

2  CONTINUE 

IF<TEST<2>.GT.O.O)GO  TO  3 
IF  <XL<2).LT.O.  .OR.ZL<:2>.LT.O.  )  GOTO  3 
IF  <XL<2).GT.X0)  GOTO  3 
IF  <XL<2),EQ.X0>  K2-1 

IF  <TEST<2).EQ.O. .OR.ZL<2>.EQ.O. >  K4=1 
12=1 

C=»**=IF  BOTH  POINTS  ARE  IN  THE  CLOUD  SET  INTERCEPTS  EQUAL  TO  THE 
C  TARGET-OBSERVER  COORDINATES  AND  RETURN— OTHERWISE  CONTINUE 

3  IF< II .EQ. 0>GO  TO  4 
IF< I2.EQ. 0)GO  TO  4 
DO  5  1=1,2 
IFLAG< I )=1 
XINT< I >=XL< I ) 

YINT< I )-YL< I > 

5  ZINTc  I>=ZL<I> 

IF  <K3,EQ, 1 )  IFLAG<1 >=2 
IF  <K4.EQ. 1  )  IFLAG<2>=2 
IF  <K1 .EQ. 1  )  IFLAG< 1  )=3 
IF  <K2.EQ.l)  IFLAG<2>=3 
GO  TO  999 

C**==*IF  ONLY  ONE  POINT  IS  IN  CLOUD  KEEP  TRACK  OF  IT  FOR  LATER 

4  CONTINUE 
IF< II .EQ. 0)GO  TO  6 
INT»1 

6  IF< I2.EQ. 0)G0  TO  7 
INT-2 

7  CONTINUE 
IF  <K1 .EQ. 1 >  LEAD=1 
IF  <K2.EQ. 1 >  LEAD-2 
IF  <K3.EQ. 1 >  ISURF-1 
IF  <K4.EQ. n  lSURF-2 

C****i.SET  UP  LOS  EQUATION  DEPENDING  UPON  CASE 
GO  TO  < 1 0,20,30), ICA8E 
C4>««>ii«CASE  f 

10  SX-DELX/DELX 
SY-DELY/DELX 
SZ-DELZ/DELX 
XI-XL< 1 )-SX*XL<  1  > 

YI=YL<  1  )-SVi«XL<  1  > 

Z1»ZL< 1 >-8Z*XL< 1 > 

GO  TO  101 
C>*iit-««CASE  2 


XYZ0071 0 
XYZ00720 
XY2U0730 
XY200740 
XY200750 
XY200760 
XY200770 
XY200780 
XYZ00790 
XY200800 

xvzooei 0 

XY200d20 
XY200830 
XY200840 
XYZ0U850 
XYZ00860 
XYZ00e70 
XYZ00880 
XY200890 
XYZ00900 
XY20091 0 
XY200920 
XYZ00930 
XYZ 00940 
XV200950 
XY200960 
XYZ00970 
XYZ00S80 
XV20C990 
XYZ01 000 
XYZ01 01 0 
XYZ01 020 
XYZOl 030 
XYZOl 040 
XYZOl 050 
XYZOl 080 
XYZOl 070 
XYZOl 080 
XYZOl 090 
XYZOl 1 00 
XYZOl 1 1 0 
XYZOl 120 
XYZOl 130 
XYZOl 140 
XYZOl 150 
XYZOl 160 
XYZOl 170 
XYZOl 180 
XYZOl 190 
XYZ01200 
XYZ0121 0 
XYZ01220 
XYZ0123U 
XYZ01240 
XYZ01250 
XYZ01260 
XYZ01270 
XYZ01280 
XYZ01290 
XYZ01300 
XYZ0131  0 
XYZ01320 
XYZ01330 
XY201340 
XYZ01350 
XYZOl 360 
XYZ01370 
XYZ01380 
XYZ01390 
XYZ01400 


104 


) 


20  SX*:DELX/DELy 
Sy=DELY/’DELY 
S2=DEL2/'DELy 
J<;i=XL<  1  )-SX*YL<  1  > 
yi*YL< 1  >-sY*yL< 1 > 

2I=2L< 1 >-S2*yL< 1 > 

GO  TO  101 

Cniitt*K<*CASt  3 

30  3X-DELX/'DEL2 
SY»DELyXDEL2 
32=DtL2/^DEL2 
XI=XL<  1  :)-SX*ZL<  1  ) 
yi»yL<  1  >-by>fZL<  i  > 

2I=2L<  1  :)-SZ*2L<  1  > 

101  CONTI Nut 

C*****SET  UP  QUADRATIC  COOEFICIENTS 
IP  <NCODt.EQ.1i  GOTO  60 
A=<  SXXXO  )*>t>2  +  <  SY,'’y0  )**2  <  32X20  >**2 

0=2 . 0*<  <  XIXXO  )*<  SXXXO  >  +  <  YI/'Y 0  >■»<  SY/YO  i  +  <  2 1 X2  0  32X20  > 

♦  -<  SXXXO  >  > 

C=<  XIXXO  >♦>••2  +  <  VIXYO  >■•"•‘2  +<2IX20)>«->i<2  -  2,0‘»XIXX0 
GOTO  61 

60  A=<  SYXYO  >*>*‘2  +  <  32X20  >'•■‘••2  -<  3XXX0  i*>»2 
B=2.0*<<SYXy0)*<YIXY0>  +  < 32X20 >*< 21X20 >  +  < SXXXO >•< XIXXO > > 
C=<  Y  IXYO  >**2  +  <2IX20;**2  -<  X  IXXO  >■*•■•■2 

61  CONTINUE 

c****^.default  all  intercepts  if  roots  are  COHPLEX 
TEST0=B-*.B-4.  OfAt-C 
IF< TESTO . GE . 0 . 0  )GO  TO  888 
800  DO  13  1=1,2 
IFLAG<  I  :'  =  0 
XINTC I >=0. 0 
YiHT< I >=0 . 0 
13  2IHT< I >=0,0 
GO  TO  389 

C*****SOLVE  QUADRATIC  FOR  X,Y  OR  2  DEPENDING  ON  CASE 
888  GO  TO  <  1  00,200,300  ■),  ICASE 
100  XINT<  1  )  =  QROOT<  +  1 ,A,B,C) 

XINT<2>=QR00T<-1 , A,B,C> 

DO  11  1=1,2 

YINT< I >=YI+SY*XINT< I ) 

11  ZINT< I  )=2I+S2*XINT< I > 

GOTO  400 

200  YINTU  >»QROOT<+1  ,A,B,C) 

YINT<2>=QR00T<-1 ,A,B,C> 

DO  21  1=1 ,2 

XIHT< I  )=XI+SX*YIMT< I > 

21  2INT< I >=ZI+SZ*YINT< I > 

GO  lO  400 

300  2INT< 1  )=QROOT<  +  1 ,A,B,C> 

ZINT<2)=GIR00T<-1  ,  A,B,C> 

DO  31  1=1,2 

XINT<  I  >=XI+SXf2INT':  1  ) 

31 _YINT< I >=YI+SY*ZINT< I > 

CHotcHt  itST  t-uR  VALID  INTERCEPTS 

4  0  0  1  1=  0 


12=0 

IFLAG< 1 >=2 
IFLAG';2>=2 
IF  <2INT<:  1  J.GE, 
IF  <2INT<2>.GE. 


IF  <2INT<:  1  J.GE,  0,  ,AND.XINT<  1  >  .  GE  ,  0  .  .AND.XINT<  1  >.LE.X0>  11  =  1 
IF  <2INT<2  >.GE. 0.  , AND . XINT< 2 > . GE . 0 . . AND . XINT< 2 > . LE , XO  )  12=1 
IF  < 1 1  ,EQ . O.OR . 12 , EQ . 0 )  GOTO  450 

IF  (.XINT<  1  >.EQ.XINT<2>,aND.YINT<  1  >  .  EQ  .  YINT<  2  >  .  AND  .  ZINT-l  1  > .  EQ  . 

*  2INT<2>>  12=0 

IF  < II .EQ, 1 . AND. I2.EQ. 1 )  GOTO  600 

C***  AT  LEAST  ONE  INTERCEPT  INVALID.  FIRST  COMPUTE  POSSIBLE  2=0,  INTCPT 
450  GOTO  <460,470,480), ICASE 
460  2=0, 

IF  <S2.EQ,0,)  GOTO  500 
X=-2IXS2 


XYZOI 4  t  0 
Xy2C1420 
XY201 430 
XY2  0t  44  0 
XYZ  0 1 43  0 
XVZOl 460 
XYZ01 470 
XYZ01480 
XY20i 490 
XY201500 
XY201 51 0 
XYZ01520 
XYZ  01330 
XYZOI 540 
XYzOI 330 
XYZ 01 560 
XYZ  01370 
XYZ 01 560 
XYZOi 390 
XV201 600 
XY,:0  1610 
XYZOI 620 
XYzOI 630 
XYZOI 640 
XYZOi 650 
XYZOI 660 
XYZOI  6.'  0 
XYZOI 660 
XY201 690 
XY201700 
XYZOI 71 0 
XYZ 01 720 
XYZ01730 
XYZ 01 740 
XYZOI 750 
XYZOi 760 
XY201770 
XYZOI 780 
XYZOI 790 
XYZ01800 
XYZ0181 0 
XYZ 01 820 
XY20i830 
XYZOI 840 
XYZOI 850 
XYZOI 860 
XYZOI 370 
XYZO 1 880 
XYZOI 890 
XY201 900 
XYZOI 91  0 
XYZOI 920 
XYZOI 930 
XYZ  0 1 94  0 
XYZOi 950 
XYZOI 960 
XYZOi 970 
XY201980 
XY,:0i99O 
XYZ 02 000 
XY20201 0 
XYZ 02 020 
XY202030 
XyZ02040 
XVZ02050 
XYZ 02 060 
XYZ 02 070 
XYZ02080 
XYZ 02 090 
XYZ 021 00 
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470 


480 

0=** 

490 


495 


C*** 

500 

505 

507 

51  0 
515 


52  0 

bOO 

620 

C*** 


y=YI+SY*X 
GOTO  490 
2=0. 

IP  <S2.EQ, 0,  >  GOTO  500 
Y=-ZI/SZ 
X=XI+SX*Y 
GOTO  490 
2=0. 

X=XI 

Y=YI 

TEST  IF  Z=0.  INTERCEPT  VhLID. 

IF  <X.GT.XO.OR.X.LT. 0.  )  GOTO  500 
IF  < NCODE . EQ . 1 >  TEST3=< Y7Y0 ifKZ-f X/XO >**2 
IF  <NC0DE.EQ.2>  TEST3=< < X-X 0 >7X 0 >**2  +  <Y/Y0>**2  -  1. 
IF  <TEST3.GT. 0. j  GOTO  500 
IF  < 1 1  .EQ, 1 >  GOTO  495 
XINT< 1  i=X 
VINT';  I  )  =  Y 
2INT<1;=2 
11  =  ) 

IF  < I2.EQ. 1 >  GOTO  600 

GOTO  500 

XIHT<2)=X 

YINT<2 J=Y 

2INT<  2  ;=<£ 

12=1 

IF  < II  .EQ. 1  )  GOTO  600 
NEXT  COMPUTE  INTERCEPT  ON  X=X0 
GOTO  < 51 0, 505, 507  ICASE 
X=X0 


Y=<X-XI )7SX 
2-2I+S2*Y 
GOTO  515 
X=X0 

2=<X-XI JXSX 
Y=YI+SY*2 
GOTO  515 
X=X0 

Y=yi+sv#x 

2=2I+S2*X 

IF  <Z.LT. 0. >  GOTO  800 
TEST4=<Y7Y0)**2  +  <:Z/Z0')*’*2  -  1 
IF  <TEST4.GT. 0.  )  GOTO  800 
IF  <  n .EQ. 1 >  GOTO  520 
XINT< 1 j=X 
YINT< 1  )=Y 
2INT< 1 >=2 
11  =  1 

IF  < I2.EQ. 0)  GOTO  800 
GOTO  600 
XINT<2)=X 
YINT<2)=Y 
ZIHT<2>=2 
12=1 

DO  620  1=1,2 
X1=<XL< 1  >-XINT< I >)**2  + 

X2-<XL<2)-XINT< I >>==2  ♦ 

0I8T< I  )=SQRT<X1 >+SQRT<X2) 

CONTINUE 

TEST5=1 . 0001=SQRT<DELX*f2+DELV=*2+DELZ*=2> 
IF<D13T< 1 >. GT. TESTS, AND. DIST< 2 >.GT, TESTS)  GOTO 
IFC INT.EQ. 0)  GOTO  700 

REPLACE  ONE  INTERCEPT  WITH  INTERIOR  OBS/TGT. 

DO  61 0  1=1,2 
IF  <XL< INT).GT.<X1NT< I  )+ 

=  GOTO  610 
IF  <YL< 1NT).GT, 

♦  GOTO  610 
IF  <2L< 1NT).GT. 

=  GOTO  610 


<  YL<  1  )-YINT<  I  )>*=2 

<  YL<2  )-VINT<  1  )>i"»2 


<ZL< 1  )-ZINT< 1  )  )==2 
<ZL<2>-ZINT< I >>==2 


800 


001 ).OR,XL<INT).LT.<XINT<I)-.001 >> 
<YINT< I )+. 001 >.OR.YL< 1NT).LT.< YINT< I 001 )> 
<ZINT< I >+.001 ).0R,2L< INT ) . LT . < ZINT< I >-, 001 )> 


XY2021 1 0 
XYZ02120 
XY202130 
XYZ02140 
XYZ02150 
XY202160 
XyZ021 70 
XYZOZISO 
XYZOZ 1 90 
XYZOZZOO 

xyz0221 0 

XYZ 02220 
XYZ02230 
XYZ 02240 
XYZ 02250 
XYZ02260 
XYZOZZi'O 
XYZ02280 
XYZ02290 
XyZ02300 
XYZ0231 0 
Xy202520 
XYZ 02330 
XYZ 02340 
Xy202350 
XY202360 
XYZ02370 
XYZ 02380 
XyZ02390 
xyz02400 
XYZ 0241 0 
XYZ02420 
XyZ02430 
XYZ 02440 
XYZ02450 
XYZ 02460 
XYZ 02470 
XY202480 
XY202490 
XYZ02500 
XYZ025) 0 
XYZ02520 
XYZ02530 
XYZ02540 
XYZ02550 
XYZ02560 
XYZ 02570 
XYZ025S0 
XyZ02590 
XYZ02600 
Xy20261 0 
XYZ 02620 
XYZ02630 
XYZ02640 
XY202650 
XYZ02660 
XYZ02670 
XYZ02680 
XY202690 
XY202700 
XyZ0271 0 
XYZ02720 
XYZ02730 
XYZ 02740 
XY202750 
XYZ02760 
XYZ02770 
XyZ02780 
XY202790 
XYZ02800 


6t  0 
C*** 


?uO 

■593 


IFLhG< I >=1 

IF  <LEAD.EQ,  INT!)  IFLrtC<I>=3 
IF  < ISURF . EQ . INT >  IFLAG< I >=2 
GOTO  700 
CONTINUE 

REPLACE  CLOSEST  INTERCEPT  OUTSIDE  LOS  RANGE 
K1  =  1 

IF  <DIST< 1  >.LT.0IST<2>)  Kl=2 
XINT<K1 j=XL< INT j 
YINT<K1  :i=YL<  INT) 

2INT<k1 >=2Lf INT) 

IFLAG<K1  )=i 

IF  <XINT<  1  ',E.<X0-.  001  ) 

IF  <XINT<2.  .E.<X0-. 001 ) 

RETURN 
END 


AND.XINTt 1 ).LE.<X0+ 
PND.XINT<2).LE,<X0+ 


OOi  ))  IFLAGc 1  )=3 
001  ) )  IFLAG<  2  )=3 


XY202S1 0 
XY2 02820 
XY202830 
XY2 02840 
XYZ02850 
XYZ02860 
XYZ02870 
XY202880 
XY202890 
XY202900 
XYZ0291 0 
XYZ02920 
XYZ02930 
XYZ 02940 
XY2 02950 
XyZ02960 


ooooo 
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SUBROUTINE  BRATE< I  ERR , MUHRD, TYPM. XN, FU, TBURN, ITVPE , EFF , YF , 
*BRAT1 ,BRAT2,BRRT3,BR«T4. BRATS) 

THIS  ROUTINE  PROVIDES  DEFAULT  MUNITION  CHARACTERISTIC  VALUES  TO 
SMOKE,  SMOKE  MUNITION  TYPES  <TYPM>  ARE  GIVEN  IN  THt  COMMENTS 
OF  THE  MAIN  ROUTINE  IN  SMOKE 


DIMENSION  BUZI  ),B2<21  ),B3<21  ).B4<21  >,B5<21  > 

DIMENSION  F<21  ),T<21  >,E<21  ),1T<21  > 

DATA  B1  /  .537, .631 . .2218, .537, .2218, 1 .. 1 t 1 1 1 0, , 
t.  0  .,  .521 , 1  .631 , 1  .808,  .  1204,  .653,  1 . 731 , 0  .,  1  .  7 

DATA  82  7 .476,- .4985, 3 .915,  ,476,3. 915, 0, ,  0. , 0. , 0.  ,  0.  ,  0 ,  ,  0,, 

^  2.106, .678,-2.556,3 .1012,-3. 136,-2.852,3.6832,0.7 

DATA  83  7  4 . 779 , 6 , 745 , - 1 . 7368, 4 . 779, - 1 . 7368 , 0 , , 0 . , 0 . , 0 . , 0 , , 0 . , 

*  0.,  0,,  -1.11,-5.907.2.883,-2.2104,15.309.4.341,-5.3472,0.7 

DATA  B4  7  -5 , 472 , -6 , 52 , -2 . 3995 , -5 . 472 , -2 . 3995, 0 , , 0 , , 0 . , 0 , , 0 , , 0 . 

*  0.,  0,,  -.748,4.012,-2.008, .206,-12.872,-3. 103,3.8348, 0.7 

DATA  B5  7  1  1  =*0  .  ,  2*  1  .  ,  8*0 . 7 

DATA  IT  73,3,3,3,3,3,1,1,1,1,1,2,2,2,2,2,2,5,5,5.4  7 
DATA  T7100,,  7 0 . , 1 2 0 . , 1 0 0 . , 1 20 . , 90 0 . , 1 . , 1 . , 1 . , 1 . , 1 . , 60 0 . , 

’f  600,  ,240.  ,470.  ,390.  ,721  .  ,260.  ,380.  ,750,  ,900.  7 


DATA  F  75 , 46, 2 , 69, i . 65, i 7 . 1 9, 7 , 50, 30 , , 0 . 76, 1 . 75, S , 1 4, 1 5 . 6, 
K  3.83,8.14,13.52, ,463, .139, .234,19,98, . 128, . 0243, 

►  19.4,40,07 

DATA  E  7  40 . ,40 . , 40 . ,40 . , 40 . ,24 . , 1 00 , , 1 00. , 1 00 . , 1 00 . , 1 00 . , 
60.  ,60.  ,66.  ,71  .  ,67.  ,77.  ,53  .  ,55.  ,51  .,  1  00.  7 

MAXS=21 

1TP=IFIX<TYPM+. 0001 > 

IF  < ITP.EQ. 0>  RETURN 
IF  ( ITP.LE.MAXS)  GOTO  1 0 
IERR=1 
RETURN 

BRAT1=8K  ITP) 

BRAT2=e2< ITP) 

BBPT3^B3< ITP) 

BRAT4=B4< ITP  ) 

BRAT5=BS< ITP ) 

ITYPE=IT< ITP ) 

IF  <MUNRD.NE. 0)  GOTO  20 
XN=1  . 

YF=0. 

TBURN=T< ITP) 

EFF=E< ITP) 

FW=F< ITP) 

RETURN 

IF  (XN.EQ, 0.  )  XN=1 . 

IF  <TBURN,EQ, 0. >  TBURN=T<ITP) 

IF  <EFF,EQ.O,)  EFF=E<ITP) 

IF  <FU.EQ. 0, )  FW=F< ITP) 

RETURN 

END 


BRAOOOt  0 
BRA00020 
BRA00030 
BRA 00 040 
BRA  0  0050 
BRA00060 
BRAu0070 
BRA  0  0080 
BRA  0  0 090 
BRA001 00 
BRA001 1 0 
0, ,BRA00120 
BRA00130 
BRA00140 
BRAOOtSO 
,  BRA00160 

BRA00170 
BRA001 80 
BRA001 90 
BRA00200 
BRA  0  021 0 
BRA00220 
BRA00230 
BRA00240 
BRA00250 
BRA00260 
BRA00270 
BRA00280 
BRA 00290 
BRA 003 00 
BRA0031 0 
BRA00320 
BRA00330 
BRA00340 
BRA00350 
6RA00360 
BRA00570 
BRA00380 
BRA00390 
BRA  0  04 00 
6RA0041 0 
BRA00420 
BRA0u430 
8RA00440 
BRA 00450 
BRA00460 
BRA 00470 
BfiA00480 
BRA00490 
BRA00500 
BRA  0  051  0 
BRA00520 
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SUBROUTINE  GPUFF< KCALL, CLuAUS , A, B, C , C2, XPP « , XPP2, YPP 1 , VPP2,2PP< , 
*2PP2  > 

THIS  ROUTINE  COMPUTES  THE  CL  CONTRIBUTION  FROM  AN  EXOTHERMIC, 
BUOYANTLY  RISING  SMOKE  CLOUD  OF  GAUSSIAN  DISTRIBUTION  AND 
UNIT  CONCENTRATION.  IT  IS  CENTERED  ON  THE  LEADING  EDGE  AT 
COORDINATES  <  A,  B,  C-2>i<SIG2  >  UHERE 
INPUTS  A  ■  CLOUD  DOWNWIND  DISTANCE 

6  «  CLOUD  BASE  HALF-WIDTH  < AT  LEADING  EDGE > 

C  -  CLOUD  HEIGHT  <AT  LEADING  EDGE) 

C2  «  MOMENTUM  RISE  COEFFICIENT.  <USUALLy  BRIGGS  OR  LIMITED 
RISE  BRIGGS) 

XPP1,...2PP2  COORDINATES  OF  TARGET  AND  OBSERVER  IN  MUNITION 
CENTERED  COORDINATE  SYSTEM  WITH  WIND  VECTOR  X-AXIS 
OUTPUT  CLGAU3  =  CL  VALUE  FOR  UNIT  MASS  <METER*»-2> 

KCALL  =  SET  TO  1  AFTER  EVERY  CHANGE  IN  TGT,^OBS  COORD, 
DIMENSION  AV<:2>,  AP<2>.BP<2),CPc2  > 

CLGAUS=0. 

IF  <KCALL.NE.0>  GOTO  100 
KCALL* 1 
I CASE =0 

COMPUTE  LOS  GENERALI2ED  COORDINATES. 

IF  (.ZPPl.LT.O.  .AND.  ZPP2.LT,0.>  RETURN 
DELX=XPP2-XPP1 


DELY=yPP2-YPP1 
DEL2=2PP2-2PP1 
IF  chBS<DELX).LE. .OlfABSCDELY) 
1  GOTO  1 0 

ICASE=1 
SX=DELX^OELX 
Sy=DELY/’DELX 
S2»DEL2/'DELX 
XI=XPP1-SX'*'XPP1 
YI*YPP1-SY*XPP1 
2I=ZPP1-SZ*XPP1 
AV< 1 >=XPP1 
AV<  2  )=XPP2 
GOTO  so 

10  IF  < ABS<DELV).LE. . 01*A8S<DEL 
ICASE*2 
SX=DELX,^DELY 
Sy=DELYZOELy 
3Z=DELZ/DELY 
XI=XPP1-SX*YPP1 
YI*YPP1-3y*yPP1 
2I=ZPP1-SZ*YPP1 
AVc’  1  )=YPP1 
AV<2>=»VPP2 
GOTO  SO 

20  IF  <ABS<DEL2).LT.  .  001  >  RETURI 
ICASE=3 
SX=DELX/DELZ 
SY*DELY/'DEL2 
S2=DELZ,^DELZ 
XI=XPP1-SX*2PP1 
YI*YPP1-SY*ZPP1 
ZI=2PP1-S2h.2PP1 
AV< 1 >=2PP1 
AVt2)=2PP2 

SO  IF  <ZPP1.LT.0.)  AV<1)«- 2I/S2 
IF  <:ZPP2.LT.  0,  >  AV<2)=-ZI/S2 
SMUL*SQRT<  SX*8X+8Y*SY+S2*SZ  > 
100  IF  <ICASE.EQ.0>  RETURN 
C***  COMPUTE  GAUSSIAN  PARAMETERS,  I 
C  ACCOUNT  FOR  GROUND  REFLECTED 


ABS<  DELX  > . LE .  . 01 *ABS<  DEL2  >  ) 


01*ABS<DEL2)>  GOTO  20 


001 >  RETURN 


ACCOUNT  FOR  GROUND  REFLECTED  SMOKE 
S1G2»<  2 . 73+C2'»A  >/’2 , 1  5 
ZB=C-<2.73+C2*A> 

IF  <ZB.GE,C>  RETURN 
3IGy=>BfSQRT<  1  .  -<  2B7C  >>**2  >72 , 1 5 
IF  <ZB.LT.0.>  SIGY*B72.15 


REAL  AND  REFLECTED  IMAGE  CLOUD  TO 


CPU0001 0 
CPU00020 
GPUOOO30 
GPU 00 040 
GPUOOOSO 
GPU00060 
GPU00070 
GPU00080 
GPUOOOSO 
CPU001 00 
CPU001 1 0 
CPU001 20 
CPU00130 
CPU00140 
GPUOul 50 
GPU00160 
GPU00170 
GPU00180 
GPUOOiSO 
GPUD0200 
GPU0021 0 
GPU00220 
GPU00230 
GPU00240 
GPU00250 
CPU00260 
CPUD0270 
GPU002SO 
GPU00290 
GPU00300 
CPU0031 0 
CPU00320 
GPU00330 
CPU00340 
GPU00350 
CPU 00360 
GPU00370 
GPU00380 
GPU00390 
GPU00400 
GPU0041 0 
GPU00420 
GPU00430 
GPU00440 
GPU00450 
CPU00460 
GPU00470 
GPU00480 
GPU00490 
CPU00500 
CPU0051 0 
CPU 00520 
GPU00530 
GPU00540 
GPUU0550 
CPU00560 
GPU00570 
CPU00580 
GPU00590 
CPU 006 00 
GPU0061 0 
GPU00620 
GPU00630 
CPU00640 
GPU00650 
GPU 00660 
GPU00670 
GPU00680 
GPU00690 
CPU 007 00 


109 


21  0 
22  0 


I 


SlGX=SIuY 

ASIG=<SX/SIGX  >*-*>2  +  <SY/'S1GY>»'*2  +  <S2/S1GZ  >**2 
BMEhN=2.*<<SX*<XI-A>/’S1GX**2>  +  <  3Y>*Y1/'SIGY»>*2  >  > 

BPC  1  )=!BMEAN+2.»SZ*<2I-2B  >/SIG2**2 
BP<  2  >=BMEAN+2  .  ■•■S2f<  2I+2B  >/SIG2‘*‘*2 
CT0T=<<XI-A)^SIGX>**2  +  <  Yl/’SIGY 
CP<1)=CTOT  +  <  <  2I-2B  J/SIGZ 
CP<:2>=CT0T  +  <<21+2B  >/'SlGZ  )<»*2 
CALCULATE  FOR  LOS  INTEGRAL 
CMUL=SMUL,-’<  2  ,  >*3  .  I  41 59f<SIGX*SIGy*SlG2*S0RT<  ASIG  >  > 

Du  220  1=1,2 

CEXU=.5'*<CP<  1  >-<BP<  1  )*-*2>/'<  4  XASIG)) 

IF  < CEXU . GT . 26 . >  GOTO  220 
INFINITE  PATH  LOS 
CLU=EXP< -CEXU ) 

CORRECTION  FOR  FINITE  PATH 
DO  210  J=i,2 

flP1=<AV<  J)+BP<  I  ),'’<2.*ASIG)>*S0RT<ASlG/2.  > 

Pi=ABS< API  ) 

CPI =0 . 

IF  <P1.LE.5.)  CP1=0, 5/’<  1  ,+Pl*f  .  0705230784+P1f(  .  042282013+Pi*( 

*  ,  0  092705272+P1*<  .  0  001  5201  34+P1  .  0002765672+P1  >♦  .  0000430638  )  )  )  )  )  ) 

IF  <AP1.GE.0.)  CPi=1.-CPl 

APC  J  )=CP1 

CONTINUE 

CLGAU3=CLGAUS+CLU*ABS< AP< 2 )-AP< 1 )) 

CONTINUE 

CLGAUS»CMULh>CLGAUS 

RETURN 

END 


GPU0071 0 
GPU00720 
GPU00730 
GPU00740 
GPU00750 
GPU00760 
GPU00770 
GPU00780 
GPU0O790 
GPU 008 00 
GPU0081 0 
GPU00820 
GPU0ud30 
GPU00840 
GPU 00850 
GPU 00860 
GPU00870 
CPU00880 
GPU00890 
CPU00900 
GPU  0  091  0 
GPU00920 
CPU00930 
GPU 00940 
GPU00950 
GPU00960 
GPU 00970 
GPU 00980 
GPU00990 
GPU01 000 
GPUD1 01 0 
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toooooooooooooooooooooooor'nonr‘00or.inooon 


SUBROUTINE  L2TRAN<WBVE1 , 1CLMAT,LB2TRN, IERR> 

THIS  SUBROUTINE  CALCULATES  MOLECULAR  ABSORPTION  COEFFICIENTS  AT 
LASER  FREQUENCIES.  PH20  AND  T  ARE  THE  PARTIAL  PRESSURE  OF  WATER 
VAPOR  AND  TEMPERATURE,  IN  TORR  AND  DEGREES  K  RESPECTIVELY. 

LID  IS  THE  LASER  LINE  IDENTIFICATION  AS  DESCRIBED  BELOW. 

ABCOEF  IS  THE  ABSORPTION  COEFFICIENT  RETURNED  IN  KM-1 . 

■tiik  « w  ix  w  ■»  m  m  « 10 1*  «  *  «  «  w  «  «  «  « ifi  1)1 « 1)1  *  «  w «  4IIII  4iiti «  %  4t  14,  jfr  « ifi «  m  w  «  «  41  iiiiii  I*  itiiiisti «  « 

INPUT 

CARD  i  LNAME1,  LNAME2,  PH20,  T,  L2PATH  FORMAT  <2A4,3F1u.3) 

LNAME<  FIRST  4  CHARS  OF  LASER  LINE  <A4> 

LNAME2  SECOND  4  CHARS  OF  LASER  LINE  < A4 > 

♦•♦IF  LNAME  NOT  ENTERED  WILL  USE  WAVELENGTH  READ  IN  MAIN 

PH20  WATER  VAPOR  PRESSURE  0.  TO  ,35  <MB>  <Fi0.3> 

T  AMBIENT  AIR  TEMPERATURE  260.  TO  .320  CO  (F10.3> 

L2PATH  PATHLENGTH  IN  KM  F<F10.3> 

**-<.PH20,  AND  T  NOT  REQUIRED  WHEN  ICLIMATECIN  MAIN>=1  OR  2 

41  ])• «  41 IX  X  41  Di « IX  41  Dt  41 41 41  iX  *  IX  4<  4i  Oi  *  41 4>  41 IX  41 41 «  4«t>  4<  4<  4>  ^  4i  I*  4t  IX  4t  41 4l  4t  4«)i  iX  iX  X  41 4<  4<  sX  %  4c  4>  4<  IX  «  4> «  Di  41 41  % 

OUTPUT 


L2TRAN 


TRANSMISSION 


NOTES 

ABCOEF  RETURNS  THE  ABSORPTION  COEFFICIENT  <KM-»> 

LNAME1  FIRST  4  CHARS  OF  LASER  LINE  OH  NORMAL  RETURN 

BLANK  ON  ERROR  RETURN 

LNAME2  SECOND  4  CHARS  OF  LASER  LINE  ON  NORMAL  RETURN 

BLANK  ON  ERROR  RETURN 

++  CALLED  PROGRAMS  •*■+ 

L21DNM 

0  3(1  )|(  If  i|t  III  4i  %  if(  ifi  4*  %  tfi  4i  41  ildti  %  111  4t  %  4i  >4(  Hi 

C  LASER  LINE  IDENTIFICATION 
C  LID=1  NDiYAG  LASER,  1.06  MICRONS 


LID=2  C02  LASER  LINE  P<20) 


10.591  MICRONS 


L10=101  TO  127  OF  LASER,  3.521  TO  4.089  MICRONS 


101  P3<12>  41  107  P3<8)  4.  113  P3<5> 

102  P3<11>  4.  108  P2<11>  4.  114  P2<8> 

103  P3<10)  4>  109  P3<7)  4.  115  P2<7> 


119  72-:  5  > 

120  P1<8) 

121  P2<4> 


104  P2<f3>  4.  110  P2<10>  4.  116  P1<10>  ■*  122  PIC?) 

105  P3<9>  4.  Ill  P3<6>  41  117  P2<6>  4.  123  P2<3> 

106  P2<12>  4.  112  P2<9)  4.  118  P1<9>  4.  124  Pt<6> 

LID=201  TO  219  CO  LASER,  4,908  TO  5.086  MICRONS 


125  PK5> 

126  P1<4> 

127  P1C3> 


201  P6<12>  *  205  P6<8)  *  209  P5<12)  41  213  P5C8)  4.  217  P4<9> 

202  P6<  11)  4.  206  P5<15>  4.  210  P5<  1 1  )  ■*  214  P5<7>  4.  218  P4<8> 

203  P6<10)  4.  207  P5<14)  4.  211  P5<10>  4.  215  P4<  1 1  >  *  219  P4<  7  > 

204  P6<  9>  4<  208  P5<  1 3  )  4.  21 2  P5<  9  )  4.  21 6  P4<  1  0  >  >* 

L1D>301  TO  305  GA  AS  LASER,  <GA.85  TO  GA.950>  LASER  LINE  NAMES 

301  0.850  MICROMETERS  41  304  0.925  MICROMETERS 

302  0,875  MICROMETERS  4.  305  0,950  MICROMETERS 

303  0.900  MICROMETERS  4< 

INTEGER  LNAME1,LNAME2, BLANK, LNAME3,LNAME4 
REAL  LAZTRN  L2rATH 

DIMENSION  a6f 0<  3 0 ) , ADF U  3 0  ) , ADF2C  3 0  > , ADF3<  3 0  > , ADF4<  3 0  > 

1  ,AOF5<30> 

DIMENSION  ACO 0<  2 0 ) , AC0 1 <  2 0  > , AC02<  2 0 > . AC03<  2 0  > , AC04<  2 0  > 

1  ,AC05<20> 

D I MENS  ION  AG A  0<  5  > , AGA 1 <  5  ) , AGA2<  5  > , AGA3<  5  > . AGA4<  5  > , 

1  ACA5<  5 ) , AC A6<  5 ) , AC A7<  5  > , AGA8<  5  > 

COMMON  /C0HST7P1 , P 1 2 , P XRAD, TWOPI , TORRMB , CDEGK 
COMMON  7CLYMAT/TEMP, PRESS, RH, AH, DP, VIS, CLDAMT, CLDHYT, 

1  FOGPRB,WNDVEL,WNDDiR, IPASCT 


LZTOOOl 0 
L2T00020 
LZT00030 
LZT00040 
L2T00050 
LZT00060 
L2T00070 
LZTOOOeO 
L2T00090 
LZT001 00 
L2T00110 
L2T00120 
L2T00130 
L2T00140 
L2T001 50 
LZT00160 
L<:T001  70 
L2T00180 
L,:T0ul90 
L2T00200 
L2T002f  0 
L2T00220 
L2T00230 
L2T 00240 
LZT00250 
L2T00260 
L2T00270 
L2T 00280 
L2T0029U 
L2T00300 
L2T0031 0 
LZT00320 
L2T00330 
L2T00340 
L2T00350 
L2T00360 
L2T00370 
L2T00380 
L2T00390 
L2T00400 
L2T0041 0 
LZT00420 
LZT00430 
L2T00440 
LZT00450 
L2T00460 
L2T00470 
LZT00480 
L2T00490 
L2T00500 
LZT0051  0 
LZT00520 
LZT00530 
LZT00540 
LZT00550 
LZT00560 
L2T 00570 
L2T00580 
L2T00590 
LZT00600 
LZT0061 0 
LZT00620 
LZT00630 
LZT00640 
LZT00650 
L2T00660 
L2T00670 
LZT00680 
LZT00690 
LZT00700 


/ 


) 


COMMON  /'lOUHlT/IOlN, lOQUT, IPHFUN,LOUNIT,NDIRTU,NCLlMT,KSTOR, 
COMMON  /'GEOMET/PTS<  15),  IGEOSW 

C  THE  POLYNOMIAL  COEFFICIENTS  ARE  SELECTED  BY  THE  LID.  THE 
C  INDEX  FOR  THE  COEFFICIENT  ARRAYS  FOR  THE  DF  LASER  IS 

C  I  -  LID  -  100.  NOW  I  IS  IN  THE  RANGE  1..2?  SINCE  THERE  ARE 

C  27  DF  LASER  LINES.  WHEN  THE  POLYNOMIAL  IS  EVALUATED  I  IS 
C  USED  TO  INDEX  THE  ARRAYS  ADF70..5/  THUS  SELECTING  THE 

C  CORRECT  COEFFICIENTS  FOR  THE  LASER  LINE  SELECTED, 

C  COEFFICIENTS  FOR  THE  OTHER  LASER  POLYNOMIALS  ARE  SELECTED 
C  IN  THE  SAME  FASHION. 

C  POLYNOMIAL  COEFFICIENTS  FOR  DF  LASER  LINES,  < 1  .  . 27  ) 

DATA  ADFO/ ,1019,  , 08352,  . 04083,  .  03675, . 02042,  . 01833, 

1  . 04738, . 03134, . 07870, . 05844, . 1096E-2, .S353E- 

2  2, ,2537E-2, .3254E-2, -. 1 1 03E-2, - , 6471 E-3, - , 1 423E- 

3  3,-.4664E-2,-.1221E-4,-.1698E-3, .1172E-3, .6195E- 

4  2, . 1272E-2, .5485E-2, , 1651E-2, . 691 3E-2 , - , 4498E- 

5  2,3*0./' 


DATA  a6f17-.9718E-4,-. 1 1 60E-3, - . 4892E-4 , - . 4230E-4 , - 
. 1750E-4,-. 1524E-4,-,5589E-4,-.4642E-4,-. 1218E- 

3,  - . 36838-4, . 1672E-4, - , 1 346E-4 , - . 4765E-6 , - , 8548E- 

6. . 60a9E-5, .8897E-5, . 1507E-5, .4448E-4, .4540E- 

7. . 5569E-6, . 1 327E-6 , - . 1 462E-4, - . 7524E-6, - . 1398E- 
5,-.7025E-6,-. 1044E-4, . 1816E-4,3*0,/ 

DATA  ADF2/.9666E-2, . 7252E-2, . 7050E-2, ,7142E-2, .6320E- 

2. . 6191E-2, .5400E-2, .5344E-2, .4064E-2, .4682E- 

2. . 3734E-2, .5839E-2, .5075E-2, .2484E-2, .8190E- 

2. . 6920E-2, .8779E-2, .7914E-2, .7094E-2. .5327E- 

3. . 6692E-2, .9452E-2, .01025, .01367, .01279, .7844E- 

2. .  01201 .3*0./ 

DATA  ADF3/-,2655E-4,-. 1805E-4,-, t879E-4,-. 1937E-4,- 
,  1704E-4,-.  1669E-4,-.  1412E-4,-.  1417E-4,-.9076E- 
5,-. 1 165E-4,-.737tE-5,-,9113E-5,-. 1290E-4,- 
.  1  070E-5,-.6746E-5,-.1573E-4,-,1683E-4,-,1883E- 

4 ,  - , 1 774E-4 , . 3002E-4 , - . 1 025E-4 , - . 2488E-4 , - . 2596E- 
4 , - . 2848E-4 , - . 2858E-4 ,-.4991 E-5, - , 26  08E-4, 3*  0 . / 

DATA  ADF4/,7847E-4, , 5729E-4, . 5585E-4, .5606E-4, .4847E- 


1 

2 

3 

4 

5 

I 

1 

2 

3 

4 

5 

I 

1 

2 

3 

4 

5 

I 

1 

2 

3 

4 

5 


r  <£  /  I  — 7  ."TO- 

4. . 4668E-4, .4145E-4, .4218E-4, .3314E-4, .3642E- 

4. . 3170E-4, ,3682E-4, ,3835E-4, .4798E-4, .3537E- 

4. . 4635E-4, .4941E-4, .5601E-4, .5494E-4,-. 1 120E- 

4. . 6567E-4, .9104E-4, .7398E-4, .8509E-4, .8746E- 

4. .  1 050E-3, . 1 060E-3,3*0./ 

DATA  ADF5/-.2056E-6,-. 1374E-6,-. 1408E-6,-. 1432E-6,- 

1  .  1222E-6,-.  n72E-6,  -.  1  01  IE-6,-.  1  054E-6 ,  -  .  7 1  69E- 

2  7, - . 8600E-7, - . 6588E-7 , - . 8998E-7 , - . 9081 E-7 , - 

3  . 1320E-6,-. 1570E-7,-.9751E-7,-.8159E-7,-, 1234E- 

4  6,-. 1313E-6, . 1836E-6,-. 1469E-6,-.2540E-6,-. 1796E- 

5  6,-, 1691E-6,-. 1886E-6,-.2635E-6,-,2855E-6,3*0./ 
POLYNOMIAL  COEFFICIENTS  FOR  CO  LASER  LINES,  <I..19> 

DATA  ACOO/-1 .813E-3,-9.289E-4, 1 . 153E-3,-1 .985E-3,- 

1  4.523E-3,-1 .205E-3,-2.225E-4,-4. 061E-3,-4,5^2E- 

2  2,-2.267E-6,-5.917E-3,-1 . 423E-3, -3 . 640E-3 , 1 , 096E- 

3  3,6.455E-4,-3.922E-3,-1 .873E-5,-1 . 055E-4, 1 .489E- 

4  2,0./ 

DATA  AC01/3  426E-5, 3 . 658E-6, -1 , 372E-6, 7 , 229E-6, 1 . 641 E- 

1  5,6.428E-6, 1 . 042E-7, 1 ,435E-5, 1 . 593E-4 , -5 . 334E- 

2  7, 1 .498E-5,5.284E-6, 1 . 806E-5, -3 . 651 E-6, - 1 .303E- 

3  6, 1 .835E-5,4,755E-6,2.330E-6,6.196E-6, 0./ 

DATA  AC02/8.813E-2,-1 . 020E-1 ,4 ,88tE-2,6 .872E-2, - 

1  6.244E-1 ,4.474E-2, 1 .226E-2,-l .462E-2, 1 .490E- 

2  1,1 ,428E-2, 1 ,934,9, 034E-3,-l , 091E-1 , 1 .284E-2,- 

3  2. 131E-2,6.543E-3,2,824E-2,9.463E-3,-9.885E-2, 0./ 
DATA  AC03/8.384E-4, 1 . 2 1 1 E-3, -4 . 687E-6, -7 . 765E- 

1  5,2.641E-3,-3. 135E-5, 1 . 620E-4, 6 . 707E-4 . 2 . 58 1 E- 

2  3,4.0188-4,-3.1 1 3E-3 , 9 . 692E-5, 7 , 907E-4 , 1 . 070E- 

3  4,3. 026E-4, 1 .216E-4,-1 . 859E-5, 4 , 274E-5, 6 . 241 E- 

4  4,0./ 

DATA  AC04/2.850E-4,-4.934E-3,-2. 176E-5, I .253E- 

1  4, 1 . 158E-3, 1 ,926E-5,9.823E-5,-2.395E-4,-6,255E- 

2  5,-6.630E-5,4.851E-3,-5, 183E-5,-6.993E-4,-8. 196E- 

3  5,-2.239E-4,-1 , 1 20E-4, 5 . 41 5E-5, -8 , 393E-5, -5 , 893E- 


NPLOTULZT0071 0 
LZT00720 
L2T00730 
LZT00740 
LZT00750 
L2T00760 
LZT00770 
LZT00780 
LZT00790 
LZT00800 
LZT0081 0 
LZT00820 
LZT00830 
LZT00840 
LZT00330 
LZT 00860 
L2T00870 
LZT00880 
LZT00890 
LZT00900 
LZT0091 0 
LZT00920 
LZT00930 
L2T00940 
LZT00950 
LZT00960 
LZT 00970 
LZT00980 
LZT00990 
LZT01 000 
LZTOl 01 0 
LZT01 020 
LZTOl 030 
LZTOl 040 
LZTOl 050 
LZTOl 060 
LZTOl 070 
LZTOl 080 
LZTOl 090 
LZTOl 1 00 
LZTOl 1 1 0 
LZTOl 120 
LZTOl 130 
LZTOl 140 
LZTOl 150 
LZTOl 160 
LZTOl 170 
LZTOl 180 
LZTOl 190 
LZT01200 
LZT0121 0 
LZT01220 
LZT01230 
LZT01240 
L2T01250 
LZT01260 
L2T01270 
LZT01280 
LZT01290 
LZT01300 
L2T01310 
LZT01320 
LZT01330 
LZT01340 
L2T01350 
LZT01360 
LZT01370 
LZT01380 
LZT01390 
LZT01400 
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4  4.0./ 

DATA  AC05/4 . 209E-6 , 3 . 426E-6 , 5 . 383E-7, 6 . 252E-8 ,-4.1 49E- 

1  6,2.374E-7,-8.637E-9,3.454E-6,1  . 526E-5 , 2 . 1 4 OE-6 , - 

2  4.282E-6,5.433E-7,4.231E-6,7.778E-7, 1 .695E- 

3  6,8.830E-7,-1 . 548E-8 , 4 . 629E-7 , 3 . 24 1 E-6 , 0 . / 

C  POLYNOMIAL  COEFFICIENTS  FOR  C02  LASER 

DATA  AC020,AC021 , AC022, AC023, AC024 , AC025, AC026, AC027, 

1  AC028/' .  4488  ,-4.1  864E-3 , 3 . 7903E-2 ,  -3 . 677  OE- 

2  4, 3.8521E-3, -4 .7330E-6, 1 . OOOOE-5,6. 0131E-7,- 

3  1  .7441E-8/' 

C  POLYNOMIAL  COEFFICIENTS  FOk  GA  AS  LASER,  <1..5> 

DATA  AGAO/7.947E-3,7.590E-3, 1 ,010,0.6094,4.271/ 

DATA  AGAt /-S . 543E-5, -3 . 544E-5,-8 . 01 2E-3, -4 . 777E-3, - 
1  3.37tE-2/ 

DATA  AGA2./1  .740E-4,1  .  203E-4 , 6 . 736E-2 , 4 . 527E-2 ,  .3364/ 

DATA  AGA3/-5.855E-7,-3. 093E-7,-2. 135E-4,-1 . 1 04E-4,- 
1  8,425E-4/ 

DATA  AGA4/-1 . 282E-5 , -9 . 236E-6, -3 . 964E-3 , -2 . 1 54E-3 , - 
1  1.615E-2/ 

DATA  AGA5/S.586E-8,4.720E-8, 1 . 596E-5, 8 . 51 2E-6 , 6 . 350E- 
1  5/ 

DATA  AGA6/5. 1 24E-8 , 5 . 235E-9 , 1 . 600E-5 , 9 . 392E-6 , 6 . 705E- 
1  5/ 

DATA  AGA7/2 . 706E-1 0, 4 . 379E-1 0, -t . 396E-7, -6 , 982E-8, - 
1  4. 72  IE-7/ 

DATA  AGA8/-4.963E-1 1 ,-5,728E-1 1,-1 . 1 25E-8, -5 . 657E-9, - 
1  4.113E-8/ 

DATA  BLANK/ 1H  / 

C  CHANGE  ACCURACY  TO  3  DECIMAL  PTS  <PGM  DATA  LIMIT) 
WAVEL=FLOAT<  IF  IX<  1  000  .  ■•WAVEl  >)/1000. 

READ  <IOIN,1100)  LNAMEl ,LNAME3,LNAME2,LNAME4,PH20,T,L2PATH 
IF< IGEOSW.NE. 1 )GO  TO  99 

L2PATHaSCiRT<  <  PTS<  4  )-PTS<  1  >  PTS<  5  )-PTS<  2  >  >-»*2+ 

+<PTS<6>-PTS<3)>*’i'2> 

99  CONTINUE 

C  CHANGE  UNITS  -  MB  TO  TORR i  C  TO  K 
PH20=PH20/T0RRMB 
T«T+CDEGK 

IF  < ICLMAT.EQ. 1 )  T-TEMP+CDEGK 
IF  <  ICLMAT.EQ.  1  )  PH20-6  .  1  1  *1  0  .  *■* 

1  <  7 . 5-»TEMP/<  TEMP+237 . 3  )  )'*RH/<  100.  *TORRMB  ) 

C  PRINT  HEADER  WHEN  THE  WAVELENGTH  CHANGES 

IF  <OLDUAV.NE, WAVED  WRITE  <IOOUT,1000> 

OLDWAV-WAVEL 

ABCOEF-0. 

IF  <WAVEL.EQ. 0. 0>  GO  TO  100 

IF  <WAVEL.LT. 0.8.0R.WAVEL,GT. 1 1 . 0>  GO  TO  900 
100  CALL  LZIDNM<WAVEL,LNAME1 ,LNAME3,LNAHE2,LNAME4,L1D> 

IF  <LID.EQ.O)  RETURN 
PZ-PHZOfPHZO 

IF  <  T . GE . 260 . AND . T . LE . 320 . AND . PH20 . CE . 0 . AND . 

1  PH20.LE.35)  GO  TO  200 

C  PRINT  WARNING  THAT  TEMP  OR  PRESSURE  IS  OUT  OF  RANGE  FOR 
C  ACCURATE  CALCULATIONS  AND  CONTINUE. 

WRITE  <IOOUT,1300) 

200  IF  <LID.GT.100)  GO  TO  500 

IF  <LID.LT. 1 .0R.LID.GT.2)  GO  TO  900 
IF  <LI0-2)  300,400,900 

C  NDiVAG  LASER.  NO  MOLECULAR  ABSORPTION  AT  1.06  MICRONS. 

300  GO  TO  800 
C  C02  LASER  LINE  P<20> 

400  T2»T>*T 

ABCOEF»AC020+AC021>»T+AC022i'PH20+AC023>1'T*PH20+AC024kP2+ 

1  AC025'»T*P2+AC026-*T2+AC027'*T2*PH20+AC028*T2fP2 

GO  TO  800 

500  IF  <LID.GT.200>  GO  TO  600 
C  DF  LASER.  I  IS  THE  LASER  LINE  INDEX 
I-LID-100 

IF  < I .GT.27>  GO  TO  900 

ABCOEF-ADFO<  I  >+ADF1<  I  >*T+ADF2<  I  >»PH20+ADF3<  I  >*Tt>PH20+ 


L2T0141 0 
L2T01420 
LZT01430 
L2T01440 
LZT01450 
LZT01460 
LZT01470 
LZT01480 
L2T01490 
LZT01500 
LZT0151  0 
LZT01520 
LZT01530 
LZT01540 
LZTOiSSii 
LZT01560 
L2T01570 
L2T01590 
LZT01390 
LZT01600 
L2T0161 0 
LZT01620 
L2T01630 
LZT01640 
LZT0I650 
LZT01660 
L2T01670 
L2T01680 
LZTOl 690 
L2T01700 
LZT0171 0 
LZT01720 
LZT01730 
L2T01740 
L2T0175O 
LZT01760 
L2T0177U 
L2T01780 
LZT01790 
LZT01800 
LZT0181  0 
LZT01820 
LZT01830 
L2T01840 
LZT0185U 
LZT01860 
LZT01870 
LZT01880 
LZT01890 
LZT01900 
LZT0191 0 
LZT01920 
LZT01930 
LZT01940 
LZT01950 
LZT01960 
LZT01970 
LZT01980 
LZT01990 
LZT02000 
L2T0201  0 
LZT02020 
LZT02030 
LZT02040 
L2T02050 
L2T02060 
LZT02070 
LZT02080 
LZT020S0 
LZT021 00 
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i  ADFH<  I  >-*'P2+rtDF5<  I  )*T'»P2 

GO  TO  800 

600  IF  <L1D.GT.300)  GO  TO  700 
C  CO  LASER.  I  IS  THE  LASER  LINE  INDEX. 

I-LIC-200 

IF  < I .GT. 19)  GO  TO  900 

ABCOEF*ACOOi:  I  )+AC01<  I  >*T+AC02<  I  )‘«‘PH20+AC03<  I  >*T>*PH20+ 
1  AC04< I  )*P2+AC05< I >*T*P2 

GO  TO  800 

700  IF  <L1D,GT.400)  GO  TO  900 
C  GA  AS  LASER.  I  IS  WAVELENGTH  INDEX, 

I=LID-300 

IF  < I .GT.5>  GO  TO  900 
T2»T*T 

ABCOEF=AGAO<  I  )+AGA1  <  I  >>*T+AGA2<  I  )>»PH20+AGA3<  I  >*T>»PH20+ 

1  AGA4<  I  )*P2+AGA5<  I  )'»T*P2+AGA6<  I  )"»T2+AGA7<  I  >>H  2* 

2  PH20+AGA8<  I  )>»T2-«‘P2 
GO  TO  800 

C  NORMAL  RETURN 

800  IF  <ABCOEF,LT. 0. )  ABCOEF=0. 

C  COMPUTE  TRANSMISSION 

LAZTRH=EXP< -L2PATH*ABC0EF ) 

WRITE  <IOOUT,1200)  WAVEL , PH20 , T. ABCOEF, LNAME1 , LNAME3, 
+LNAME2,LNAME4,L2PATH,LA2TRN 
RETURN 

C  ERROR  RETURN 

900  WRITE  < lOOUT, 1400) 

LNAME1 -BLANK 
LNAME3-BLANK 
LNAI<1E2-BLANK 
LNAME4-BLANK 
LAZTRN-1 . 

IERR-1 

RETURN 

*'1000  FORMAT  </',69X.  1  OHABSORPTION,/,23X,  1 1H  WAVELENGTH,  4X, 

1  12HH20  PRESSURE, 4X, 1 1HTEMPERATURE,4X, 

2  1 1HC0EFFICIENT,6X,4HLINE,9X, 10HPATHLENGTH,4X, 

3  1 2HTRANSMISS ION, /,24X,9H< MICRONS >,8X,6H<TORR) 

4  , 1 1X,5H<ABS), 1 0X,6H<KM-1 >, 24X, 4H< KM ), / > 

1100  FORMAT  <4<A2),3F1 0.3) 

1200  FORMAT  <1H  , 22X , F 09 . 3 , F 1 5 . 3 , F 1 6 . 2 , E 1 6 . 3, 7X, 4< A2 ) , 5X , 

1  El  0.4, 5X, El  0.4) 

130  0  FORMAT  <  39H  *•*"*  WARNING  VALUE  OF  T  OR  PH20  OUT  OF  , 


1 OHRANGE  /2Q» 

25HPH20  RANGE  -  0 


T  RANGE  ■> 
TO  35  TORR) 


260  TO  320 


1400  FORMAT  <40H  ERROR  WAVELENGTH  OUT  OF  ACCEPTABLE 

1  7HRANGE:  , 26H  .8  TO  11.0  MICRONS  ,7, 

2  37H  CONTROL  RETURNED  TO  MAIN  FROM  LZTRAN > 


L2T021 1 0 
LZT02120 
L2T02130 
LZT02140 
L2T02150 
L2T02160 
LZT02170 
L2T02180 
LZT  02190 
LZT02200 
LZT0221 0 
LZT02220 
LZT02230 
LZT 02240 
L2T02250 
L2T02260 
LZT02270 
L2T022e0 
LZT02290 
LZT 023 00 
LZT  0231 0 
LZT02320 
LZT02330 
LZT02340 
I  2T02350 
LZT02360 
LZT02370 
LZT02380 

LZT02390 

LZT 02400 
LZT024f 0 
L2T02420 
L2T02430 
LZT02440 
L2T02450 
LZT02460 
LZT 02470 
L2T02480 
L2T02490 
LZT02500 
LZT0251 0 
LZT02520 
LZT02530 
LZT02540 
LZT02550 
LZT02560 
LZT02570 
LZT02580 
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SUBROUTINE  L21DNM<  WAVEL  ,  LNAHE 1  ,  LHAME3.  LNAME2,  LH(!|ME4 ,  L 10  >  LZI 

THIS  SUBROUTINE  CONVERTS  THE  WAVELENGTH  IN  MICRONS  OR  THE  LASER  LZI 

LINE  NAME,  IF  WAVEL  «  0,  TO  AN  INTEGER  LASER  10  NUMBER  WHICH  IS  LZI 

USED  BY  L2TRAN.  LZI 

++  WAVEL  TO  LIO,  WHEN  WAVEL  HOT  =  0  ♦♦  LZI 

THE  SUBROUTINE  DOES  A  BINARY  SEARCH  OF  THE  ARRAY  AWAVEL  TO  FIND  LZI 

A  MATCH,  WAVEL  -  AWAVEL<Kj.  WHEN  A  MATCH  IS  FOUND  THE  LASER  ID  LZI 

IS  LOADED  FROM  THE  ID  ARRAY,  LID  «  AID<K>.  THE  LASER  LINE  NAME  LZI 

IS  ALSO  LOADED  INTO  TWO  VARIABLES,  LNAME1  =  INAMEKK)  LNAME2  =  LZI 

INAMEZ<K).  IF  AN  EXACT  MATCH  IS  NOT  FOUND  THE  CLOSEST  STANDARD  LZI 

TO  THE  PARAMETER  WAVEL  IS  USED.  A  WARNING  IS  PRINTED  AND  K  IS  LZI 

SET  TO  THE  PROPER  VALUE  SO  IT  CAN  BE  USED  TO  INDEX  THE  ID  AND  LZI 

LINE  ARRAYS.  LZI 

++  LASER  LINE  TO  LID,  WHEN  WAVEL  -  0  •♦+  LZI 

WHEN  THE  WAVELENGTH  PARAMETER  IS  ZERO  THE  CONVERSION  IS  DONE  LZI 

FROM  LASER  LINE  NAME  TO  LID.  A  SEQUENTIAL  SEARCH  OF  THE  LINE  LZI 

NAME  ARRAY  IS  PERFORMED.  WHEN  A  MATCH  IS  FOUND  k  IS  SET  AND  LZI 

WAVEL  AND  LID  ARE  LOADED  FROM  THE  APPROPRIATE  ARRAYS.  WHEN  LZI 

NO  MATCH  IS  FOUND  AN  ERROR  MESSAGE  IS  PRINTED  AND  LID  IS  SET  LZI 

TO  ZERO.  LID  IS  USED  TO  NOTIFY  LZTRAN  THAT  AN  ERROR  HAS  LZI 

OCCURED  AND  NO  CALCULATIONS  SHOULD  BE  PERFORMED.  LZI 

♦+  PARAMETERS  ++  LZI 

WAVEL  LASER  WAVELENGTH  (MICRONS)  LZI 

*■*<■*  INPUTS  IF  WAVEL  »  0.0  LZI 

LHAME1  FIRST  4  CHARS  OF  LASER  LINE  LZI 

LZI 

LNAME2  SECOND  4  CHARS  OF  LASER  LINE  LZI 

RESULTS  ++  LZI 

LID  LASER  LINE  IDENTIFIER  '  Lzl 

LNAMEI  FIRST  4  CHARS  OF  LASER  LINE  LZI 

LZI 

LNAME2  SECOND  4  CHARS  OF  LASER  LINE  LZI 

LZI 

INTEGER  AID<53)  LZI 

COMMON  /lOUNITZIOIN, lOOUT, IPHFUN,LOUNIT, NOIRTU,NCLIMT, KSTOR,  NPLOTULZI 
DIMENSION  AWAVEL<:53),INAMEK106),INAME2<53)  LZI 

DATA  AWAVELZ.85, .875, .9, .  LZI 

1  925,  .95, 1  . 06,3.521 ,3.55,3.581 ,3 .612,3.636,3.645,  LZI 

2  3.666,3.679,3.698,3.715,3.731 ,3.752,3.765,3.8,  LZI 

3  3.82,3.837,3.854,3.875,3.89,3.915,3.927,3.956,  LZI 

4  3.965,3,999,4.005,4.046,4.089,4,908,4.918,4.928,  LZI 

5  4.938,4.948,4.972,4  982,4.992,5.002,5.012,5.022,  LZI 

6  5.032,5.043,5.047,5.054,5.057,5.067,5.078,5.088,  LZI 

7  10.591.^  LZI 

DATA  AIDZ301 ,302,303,304,305, 1 , 127, 126, 125, 124, 123,  LZI 

1  122,121,120,119,118,117,116,115,114,113,112,111,  LZI 

2  110,109,108,107,106,105,104,103,102,101,219,218,  LZI 

3  217,216,215,214,213,212,211,210,209,208,207,205,  LZI 

4  206,204,203,202,201  ,2*'  LZI 

DATA  I NAME  1  /2HGA , 2H . 8 , 2HGA , 2H . 8, 2HGA , 2H . 9 , 2HCA , 2H . 9 , 2HCA , 2H . 9 , 

1  2HRU,2HBY,2HP1 , 2H< 3 , 2HP 1 , 2H< 4 , 2HP 1 , 2H< 5 , 2HP 1 , 2H< 6 , 2HP2, 2H< 3 , 

2  2HP 1 , 2H<  7 , 2HP2 , 2H<  4 , 2HP 1 , 2H<  8 , 2HP2 , 2H<  5 , 2HP 1 , 2H<  9 , 2HP2 , 2H<  6 , 

3  2HP1 ,2H< 1 ,2HP2,2H<7,2HP2,2H<8,2HP3,2H<5,2HP2,2H<9,2HP3,2H<6, 

4  2HP2,2H< 1 ,2HP3,2H<7,2HP2,2H< 1 ,2HP3,2H<8,2HP2,2H< 1 ,2HP3,2H<9, 

5  2HP2,2H( 1 ,2HP3,2H< 1 ,2HP3,2H< 1 ,2HP3,2H< 1 , 2HP4 , 2H( 7 , 2HP4 , 2H< 8, 

6  2HP4,2H<9,2HP4,2H< 1 ,2HP4,2H< 1 , 2HP5, 2H< 7, 2HP5, 2HC 8, 2HP5, 2H< 9, 

7  2HP5,2H< 1 ,2HP5,2H< 1 ,2HP5,2H< 1 ,2HPS,2H( 1 ,2HP5,2H< 1 ,2HP6,2H<8, 

8  2HP5 , 2H(  1 , 2HP6 , 2H<  9 , 2HP6 , 2H< 1 , 2HP6 , 2H< 1 , 2HP6 , 2H< 1 , 2HP< , 2H2 0/ 

DATA  1NAME271H5,2H75, 1H  ,2H25,1H5,1H  , 1 1 H >, 2H0 >, 5*  LZI 

1  1H>,2H0),  1H),2H1  ),  1H),2H2),  1H>,2H3),2H0>,2H1  >,  LZI 

2  2H2),3>*>1H),2H0>,2H1  ),3*1H),2H0>,2H1  ),2H2),2H3),  LZI 


0001  0 
00020 
00030 
00040 
00050 
00060 
00070 
00080 
00090 
001  00 
001  1  0 
00120 
00130 
0  014  0 
00150 
0  0 1 1-  0 
00170 
00180 
0  0190 
00200 
0021  0 
0  022  0 
00230 
00240 
00250 
00260 
0027  0 
00280 
00290 
00300 
00310 
00320 
00330 
00340 
00350 
00360 
00370 
00380 
00390 
00400 
0041  0 
00420 
00430 
00440 
00450 
00460 
0  047  0 
00480 
00490 
00500 
0051  0 
00520 
00530 
00540 
0  0550 
0  056  0 
00570 
0  0580 


:00660 

:00670 

00680 


3  2H4  ),  1H>,2H5),  1H>,2H0>,2H1  >,2H2>,  iH>/ 

DATA  IFIRST, lLAST/1 .SS/ 

I=IFIRST 

J=ILAST 

TU«VEL=WhVEL 

CHECK  FOR  WAVELENGTH  OR  LASER  LINE  PASSED  AS  INPUT.  IF 
WAVEL  =  0  THEN  DO  A  SEOUEHTIAL  SEARCH  ON  LINE  NAME, 

LNAMEt ,LNAME2, 

IF  < WAVEL, NE. 0. 0>  GO  TO  200 
INPUT  =  LASER  LINE  NAME 
SEQUENTIAL  SEARCH  LOOP 
DO  1 00  K=IFIRST, ILAST 
1 

IF<<LNAME1 .EQ. INAME1<KK)).AN0.<LNAHE3.EQ. 1NAME«<KK+1 >>>  GO  TO  1 
GO  TO  100 

10  IF  <LNAME2.EG.  IHAME2<;K))  GO  TO  600 
100  CONTINUE 

ERROR,  NO  MATCH  ON  LASER  NAME 
LID=0 

PRINT  ERROR  MESSAGE 

WRITE  <IOOUT,900>  LNAMEl ,LNAME3,LNAME2,LHAME4 
GO  TO  700 
INPUT  =  WAVELENGTH 
eiNARV  SEARCH  LOOP 
20  0  K=<I  +  J>/'2 

IF  <WAVEL,LE, AWAVEL<K>)  J-K-1 
IF  < WAVEL. GE.AUAVEl<K>)  I=K+1 
IF  < I .LE. J>  GO  TO  200 

DID  WAVELENGTH  MATCH  A  STANDARD  IN  AWAVEL<=*>  ? 

IF  < 1-1 ,GT. J)  GO  TO  600 

WAVELENGTH  NOT  EXACTLY  EQUAL  TO  ONE  OF  THE  STANDARDS  IN  ARRAY 
AWAVEL.  CHANGE  WAVELENGTH  TO  EQUAL  THE  STANDARD  IT  IS  CLOSEST  TO. 
THEN  PRINT  WARNING  OF  CHANGE. 

IF  <WAVEL. GT.AWAVEL<K). AND. K.EQ. ILAST)  GO  TO  500 
IF  <WAVEL.LT.AWAVEL<K).AND.K.EQ.IFIRST)  GO  TO  500 
IF  <WAVEL-AWAVEL<K))  300,600,400 
WAVEL  LT  AUAVEL<K) 

CHECK  IF  CLOSER  TO  AWAVELCK)  OR  AWAVEL<K-1> 

300  DELTAt =UAVEL-AWAVEL< K-1 > 

DELTA2*AWAVEL<  K  >-WAVEL 
IF  <DELTA1 .LT,DELTA2)  K«K-1 
GO  TO  500 

WAVEL  GT  AWAVEL(K) 

CHECK  IF  WAVEL  CLOSER  TO  AWAVEL<K)  OR  AWAVEL<K+1> 

400  DELTA1=WAVEL-AWAVEL<K) 

DELTA2=AWAVEL<K+1 >-WAVEL 
IF  <DELTA2.LT,DELTA1 >  K=K+1 
PRINT  WARNING 
500  WAVEL=AWAVEL<K) 

WRITE  <IOOUT,600)  TWAVEL, WAVEL 
LOAD  LASER  ID  NUMBER 
600  LID»AID<K> 

LOAD  LINE  NAME 
KK’=2’*K—  1 

LNAMEl'=INAME1<KK) 

LNAME3-INAMEKKK+1  ) 

LNAME2«1NAME2<K) 

LOAD  WAVELENGTH 
WAVEL»AWAVEL<K) 

?00  RETURN 

800  FORMAT  < 29H  ***  WARNING  INPUT  WAVELENGTH, F7 . 3, 

1  11H  CHANCED  T0,F7.3,18H  NEAREST  STANDARD  , 

2  1  4HWAVELENGTH  ■•>•♦) 

900  FORMAT  <  24H  ERROR  LASER  LINE  #,4<A2),6H#  NOT  , 

1  9HVALID  CONTROL  RETURNED  TO  MAIN  , 

2  12HFR0M  LZTRAN.) 


L2I00690 
L2I00700 
L2I0071 0 
LZI00720 
LZI00730 
LZIC0740 
L2I00750 
LZI00760 
LZI00770 
LZI00780 
LZI 00790 
LZI00800 


LZ100820 
LZ1U0830 
LZI00840 
LZI 00850 
LZI00860 
L2I00S70 
LZI00880 
LZI 00890 
LZI00900 
L<:1  0091  0 
L2100920 
LZ100930 
LZI 00940 
LZI0C950 
LZI00960 
LZI00970 
LZI00980 
LZI 00990 
LZI01000 
LZI01 01 0 
LZ101 020 
LZI01 030 
LZI01 040 
LZI 01 050 
LZI01 060 
LZI01 070 
LZIC1 080 
LZI01 090 
LZI 01 1 00 
LZI01  1  1  0 
LZI01 120 
LZI01 130 
L2I01140 
LZI01 150 
LZlOt 160 
LZI01  170 
L2I01 180 
LZ101 190 

LZI01200 

L2I0121 0 
LZI01220 
LZI01230 
LZI01240 
LZI01250 
LZI01260 
LZIC1270 
LZI01280 
LZI01290 
LZ101300 
LZI0131  0 
L2I01320 


t16 


000000000000000000000000000000000000000000000000000000000000000000000 


SUBROUTINE  ORTRAN< WAVE  1 , ICLMrtT, TRNLOS, lERR >  DRTOOulu 

ORT00020 

DRT00040 
DRT00050 

PURPOSE  DRT00060 

DIRTRPN-2  EXPLOSION  PRODUCED  PND  VEHICLE  GENERPTED  DUST  MODEL  DRTu0070 

DRT00080 

INPUT, OUTPUT  PND  CPLLING  PROGRPH  DRT00090 

DRT001 00 

INPUTS  DRTOOIIu 

DRT00120 

VPLUES  IN  PRGUMENT  LIST  DRT00130 

DRT00140 

ICLMPT  INTEGER  VPLUE  USED  TO  INDICPTE  HOW  NETEORLuGICPL  DPTP  IS  TO  DRT00150 
BE  MPDE  PVPILPBLE  IF  ICLMPT  IS  DRTOOIbO 

a  -  MET1  IDENTIFIER  WITH  THE  PPPROPRIPTE  PPRPMETER3  PRE  TO  DRT00170 


ICLMPT  INTEGER  VPLUE  USED  TO  INDICPTE  HOW  NETEORLuGICPL  DPTP  IS  TO  DRT00150 
BE  MPDE  PVPILPBLE  IF  ICLMPT  IS  DRTOOIbO 

a  -  MET1  IDENTIFIER  WITH  THE  PPPROPRIPTE  PPRPMETER3  PRE  TO  DRT00170 
BE  REPD  IN 

1  -  NECESSPRV  METEORLOGICPL  DPTP  IS  PPSSED  IN  C0MM0H^CLYMPT7  DRTOOIBO 
PND  MET1  IS  NOT  TO  BE  REPD  IN  DRT00190 

DRTuOBOO 

WAVE1  WPVELENGTH  IN  MICROMETERS.  USED  TO  DETERMINE  NWL .  DRT0021 0 

WHERE  NWL  IS  PN  INTEGER  INDEX  FOR  WPVELENGTH  DETERMINEDDRT00220 
WITHIN  THE  CODE  DRT00230 


WPVEl 

0.4  -  0.7  MICROMETER  (VISIBLE) 
O.a  -  1.1  MICROMETER 

3.5  -  4.0  MICROMETER 

8.5  -  12.0  MICROMETER 
2100  -  3200  MICROMETER 


INPUTS  TO  BE  READ 


EACH  INPUT  RECORD  BEGINS  WITH  A  4  LETTER  IDENTIFIER  IN  COLUMNS 
1-4  FOLLOWED  6V  AS  MANY  (REAL)  FIELDS  AS  NEEDED,  UP  TO  9,  8  COLUMNS 
PER  FIELD  BEGINNING  IN  COLUMN  9. 

THE  INPUT  FILE  MAY  CONTAIN  SEVERAL  SEQUENCES  OF  THE  FOLLOWING 
RECORDS.  EACH  SEQUENCE  SEPERATED  BY  A  GO  CARD.  ONCE  THE  INITIAL 


DRT00240 
DRT00250 
DRT002S0 
DRT00270 
DRT  00260 
DRT00290 
DRT00300 
DRT 0031 0 
DRT  00320 
DRT00330 
DRT00340 
DRT00350 
DRT  00360 
DRT00370 


SEQUENCE  HAS  BEEN  REPD  IN  AND  THE  MINIMUM  REQUIREMENTS  FOR  EXECUTION  DRT003d0 


OF  THE  DESIRED  OPTION  HAS  BEEN  SATISFIED, ANY  FOLLOWING  SEQUENCE  MAY 
CONTAIN  A  SUBSET  OF  THE  INITIAL  RECORDS  REDEFINING  INPUT  VARIABLES 
PS  DESIRED  OR  MAY  CONTAIN  A  COMPLETELY  NEW  SET  OF  RECORDS. 

EACH  SET  OF  INPUTS  MUST  END  WITH  A  DONE  CARD** 


RECORD 

MET1 


NATMOS 


TMPME3 


WNDMES 


THWND 


INTEGER  WITH  VALUES  1 


CATEGORIES 


TO  F. 


CORRESPONDING  TO  PP3QUILL 


THE  HEIGHT  AT  WHICH  A  TEMPERATURE  MEASUREMENT 


AVAILABLE.  VALID  RANGE 


100.0  M . 


THE  TEMPERATURE  MEASURED  IN  DEGREES  KELVIN  TAKEN  AT 
HEIGHT  ZTMP.  VALID  RANGE  270.0  -  315.0. 

THE  HEIGHT  AT  WHICH  A  WIND  SPEED  MEASUREMENT  IS 
AVAILABLE.  VALID  RANGE  0.5  -  100.0  M. 

THE  WIND  SPEED  IN  HETERS/SECOND  MEASURED  AT  ZWND 
VALID  RANGE  .1  -  20.0  M/'S 

THE  ANGLE  THAT  THE  WIND  VELOCITY  VECTOR  MAKES 
WITH  THE  USER'S  POSITIVE  X  AXIS  MEASURED  IN  DEGREES 
COUNTERCLOCKWISE.  WHERE  THE  USERS  POSITIVE  X-AXIS 
POINTS  EAST.  THUS  THWND  IS  THE  ANGLE  THAT  THE  WIND 
VELOCITY  VECTOR  MAKES  WITH  THE  EAST. 

VALID  RANGE)  -360.0  -  360.0  DEGREES. 

NOTE)  THWND  IS  NOT  NEEDED  FOR  OPTION  3 


DRT00390 
DRT00400 
DRT004t  0 
DRT00420 
DRT00430 
DRT00440 
DRT00450 
DRT00460 
DRT00470 
DRT00480 
DRT00490 
DRT00500 
DRT0051 0 
DRT00520 
DRT00530 
DRT00540 
DRT00550 
DRT00560 
DRT00570 
DRT  OOSSO 
DRT00590 
DRTOaSOO 
DRT0061 0 
DRT00620 
DRT00630 
DRT00640 
DRT00650 
DRT00660 
DRT00670 
DRT00680 
DRT00690 
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RECORD  2 
MET2 


RECORD  3 
SOIL 

NSOIL 


RECORD  4 
CHAR 

NCHRG 


DETDEP 


RECORD  5 
EXPL 


A  FLAG  TO  INDICATE  WHETHER  THE  INVERSION  LAYER  HEIGHT 
IS  GROWING  OR  NOT.  IF  ID  IS 


DRT00700 
DRT0071 0 
DRT  00720 
DRT00730 
DRT00740 
DRT00750 


THE  INVERSION  LAYER  HEIGHT  IS  RELATIVELY  CONSTANTDRT00760 

1 .  THE  INVERSION  LAYER  HEIGHT  IS  GROWING  DRT00770 

DkT00780 

THE  LATITUDE  OF  THE  DETONATION  SITE,  DRT00790 

VALID  RANGE  1.0  -  SO.  DEGREES.  THAT  IS  THE  NORTHERN  DRTOOSOO 
HEMISPHERE.  DRTOOSiO 

DkT00620 

DRT00830 

DRT00S40 

DRT00850 

INTEGER  INDEX  OF  SOIL  TYPE.  NSOIL  IS  DRTOOSSO 

1.  FOR  SOIL-1.  <DATA  GRAF-11 >  EXPLOSIONS  ONLY.  DRT00870 

2.  FOR  SOIL-2,  <OATA  DIRT-I  )  EXPLOSIONS  ONLY.  DRT00880 

3.  FOR  SOIL-3,  <OATA  SMOKEWEEK-II >  VEHICLES  ONLY,  DRT00890 

DRTOOSOO 

DEPTH  OF  SOD  IN  METERS  DRTOOSIO 

VALID  RANGE!  0.0  -  1.0  M.  DRTO0S2O 

NOTE!  FOR  VEHICLE  MODEL  IF  DSOO>0.0  NO  DUST  IS  DRT00930 

GENERATED  DRT00940 

DRT00950 

SILT  CONTENT  OF  SOIL  < PARTICLE  DIAMETERS  <  75  MICRONS)  DRT00980 

I.E,  SILT-. 15  INDICATES  A  SILT  CONTENT  OF  15X  DRT00970 

NOTE:  THIS  INPUT  NEEDED  ONLY  FOR  VEHICLE  MODEL  (lOPT-S >DRT009S0 

DRT00990 
DRTD1 000 
DRT01 01 0 
DRT01 020 

CHARGE  TYPE  INDEX  WITH  FOLLOWING  VALUES  ORT01030 

1.  SURFACE  -  LIVE  FIRE  OR  30  DEGREE  TILTED  DRT01040 

STATIC,  TIP  ON  GROUND  DRT 01 050 

2.  BARE  CHARGE  ON  SURFACE  DRT 01 060 

3.  30  DEGREE  TILTED  TIP  AT  0.3  METER  DEPTH  DRT01070 

4.  30  DEGREE  TILTED  TIP  AT  0,6  METER  DEPTH  DRT01080 

5.  HORIZONTAL  PROJECTILE  ON  SURFACE  DRT01090 

DEFAULT  VALUE  IS  1  IF  NCHRG  IS  NOT  BETWEEN  1  AND  5.  DRT01100 

DRT01 1 1 0 

THE  WEIGHT  OF  THE  CHARGE  IN  KG-TNT,  DRT01120 

VALID  RANGE!  0.1  -  100.0  KG-TNT.  DRT01130 

DRT01 140 

THE  DEPTH  OF  DETONATION  IN  METERS,  DRT01150 

VALID  RANGE:  0.0  -  2.0  M.  DRT01160 

DR.T01 170 
DRT01 180 
DRT01 190 
DRT01200 

TYPE  OF  CHARGE  DISTRIBUTION  <USED  FOR  PROPER  INPUT  AND  DRT01210 
OUTPUT  FORMATS)  IF  THE  VALUE  OF  NARY  AND  lOPT  OF  THE  GODRT01220 
CARD  ARE  NOT  COMPATIBLE  CATASTROPHE  COULD  RESULT!  DRT01230 

NOTE:  WHEN  NARY  IS  DRT 01 240 

1,  lOPT  MUST  ALSO  BE  1,  DRT01250 

2,  lOPT  MUST  ALSO  BE  2.  DRT01260 

3,  lOPT  MUST  BE  4.  DRT01270 

.-SIMULTANEOUS  BURST,  UNIFORMLY  DISTRIBUTED  CHARGES  0RT012.80 

IN  A  PARALLELOGRAM.  ORT01290 

<SPECIAL  CASES  ARE  .SINGLE  CHARGE  .RECTANGLE  AND  DRT01300 

ZIG  ZAG  PATTERN)  DRT0t310 


THE  LATITUDE  OF  THE  DETONATION  SITE, 


VALID  RANGE  1.0  -  90 
HEMISPHERE. 


DEGREES.  THAT  IS  THE  NORTHERN 


INTEGER  INDEX  OF  SOIL  TYPE.  NSOIL  IS 

1.  FOR  SOIL-1,  <DATA  GRAF-11 >  EXPLOSIONS  ONLY. 

2.  FOR  SOIL-2,  <OATA  DIRT-I)  EXPLOSIONS  ONLY. 

3.  FOR  SOIL-3,  <OATA  SMOKEWEEK-II >  VEHICLES  ONLY, 

DEPTH  OF  SOD  IN  METERS 
VALID  RANGE:  0.0  -  1.0  M. 

NOTE:  FOR  VEHICLE  MODEL  IF  DSOO>0.0  NO  DUST  IS 
GENERATED 


CHARGE  TYPE  INDEX  WITH  FOLLOWING  VALUES 

1 .  SURFACE  -  LIVE  FIRE  OR  30  DEGREE  TILTED 
STATIC,  TIP  ON  GROUND 

2.  BARE  CHARGE  ON  SURFACE 

3.  30  DEGREE  TILTED  TIP  AT  0.3  METER  DEPTH 

4.  30  DEGREE  TILTED  TIP  AT  0,6  METER  DEPTH 

5.  HORIZONTAL  PROJECTILE  ON  SURFACE 
DEFAULT  VALUE  IS  1  IF  NCHRG  IS  NOT  BETWEEN  1  AND  5. 

THE  WEIGHT  OF  THE  CHARGE  IN  KG-TNT, 

VALID  RANGE:  0.1  -  100.0  KG-TNT. 

THE  DEPTH  OF  DETONATION  IN  METERS, 

VALID  RANGE:  0.0  -  2.0  M. 


2. -SIMULTANEOUS  BURST, RANDOMLY  DISTRIBUTED  CHARGES, 


DRT01230 
DRT01240 
DRT01250 
DRT01260 
DRT01270 
DRT 01 280 
DRT01290 
DRT01300 
DRT0t31 0 
DRT01320 
DRT01330 


DRT01340 

3. -SEQUENTIAL  IN  TIME  AND  RANDOM  IN  SPACE  DISTRIBUTION  OF0RT0t350 
CHARGES.  DRT01360 


NOTE: 

WHEN  NARY-2.  EACH  CHARGE  LOCATION  MUST  BE  SPECIFIED 


DRT01360 

DRT01370 

DRT01380 

DRT01390 
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WHEN  NARY-3.  ErtCH  CH#»Ri:iE  LOCATION  AND  DETONATION  TIMEDRTOt  40u 


MUST  BE  SPECIFIED 
THE  CHARGE  LOCATIONS  ARE  INPUT  DIRECTLY  FOLLOUING 
THIS  INPUT  RECORD  WITH  ONE  LOCATION  < AND  DETONATION 
TIME  IF  APPROPRIATE)  PER  RECORD . 


NCH3 


DRT01 41 0 
DRT01420 
DRTCI1430 
DRTOI 440 
DRT01450 
DRT01460 
DRT01470 
DRT01480 
DRT0t490 


SRCBAS 


SINGLY  DIMENSIONED  ARRAY  SPECIFING  NUMBER  OF  CHARGES 
WITH  THE  MAXIMUM  TOTAL  OF  CHARGES  200, 

WHEN  NARY=t.  NCHS< 1 )  IS  THE  NUMBER  OF  CHARGES  IN  THE 

DIRECTION  OF  SIDE)  AND  NCHS<2)  IS  THE  HUMBER  OF  _  .. 

CHARGES  IN  THE  DIRECTION  OF  SIDE2.  FOR  A  SINGLE  CHARGE  DRT01500 
SET  NCHS<  1  )-HC.HS<2  )-1  .  .  DRTOI  510 

WHEN  NARY»2,  OR  3.  NCHS< 1 )  IS  THE  TOTAL  NUMBER  OF  DRTOI 520 

CHARGES  AND  SET  NCHS<2>=1..  DRT01550 

DRT  01540 

SINGLY  DIMENSIONED  ARRAY  CONTAINING  THE  COORDINATES  OF  DRTOI 550 
A  CORNER  POINT  OF  THE  BOUNDING  PARALLELOGAM  WHEN  DRTOI 560 

NARY=1 .  AND  IS  ALSO  USED  AS  THE  REFERENCE  CHARGE  DRT01570 

BY  THE  OBSERVER.  THAT  IS,  SRCBAS  IS  THE  ORIGIN  OF  THE  DRT015S0 
OBSERVERS  COORDINATE  SYSTEM,  WHEN  NARY=2 .  OR  3,  DRT01590 

SRCBAS  SHOULD  HOT  APPEAR  ON  THE  INPUT  FILE  AS  COOR< I , 1 >DRTOi 600 
IS  USED  AS  THE  REFERENCE  CHARGE.  WHERE  COOR< 1 , 1  )  IS 
THE  FIRST  CHARGE  LOCATION  SPECIFIED. 

VALID  RANGE  -10000.0  -  10000.0 


SIDEl 


SINGLY  DIMENSIONED  ARRAY  NECESSARY  ONLY  WHEN  NARY*1 . 

SPECIFING  ONE  SIDE  OF  THE  BOUNDING  PARALLELOGRAM 
FROM  THE  POINT  SRCBASd).  THAT  IS,  SIDEl  IS  A  VECTOR  _ 

TO  THE  NEXT  CHARGE  ALONG  ONE  SIDE  OF  THE  PARALLELOGRAM .DRTOI 680 
WHEN  NARY=2.  OR  3.  THIS  VARIABLE  SHOULD  HOT  APPEAR  ON  DRTOI 690 
THE  INPUT  FILE.  - 


DRT0161 0 
DRT01620 
DRTOI 630 
DRTOi 640 
DRT01650 
DRT01660 
DRT01670 


DRTOI 700 
DRT0171 0 

SIDE2  SINGLY  DIMENSIONED  ARRAY  NECESSARY  ONLY  WHEN  NARY-1 .  DRTOI 720 

^  ^  _  DRT01730 

DRT01740 
DRT01750 
DRT01760 
DRT01770 
DRTOI 780 
DRT 01 790 

THE  FOLLOWING  RECORD  MUST  APPEAR  THE  APPROPRIATE  NUMBER  OF  TIMES  DRT01800 
**  IMEDIATELY  FOLLOWING  THE  ABOVE  RECORD  IF  NARY  IS  2.  OR  3,  ON  THE  DRT01810 
ABOVE  RECORD.  THAT  IS  IT  MUST  APPEAR  THE  SAME  NUMBER  OF  TIMES  DRT01820 
AS  THER  ARE  CHARGES  AS  SPECIFIED  ON  RECORD  EXPL,  <I,E.  IF  NARY=2 ,  DRTOI  830 
AND  NCHS-5.  THE  THIS  RECORD  MUST  APPEAR  5  TIMES. 


SINGLY  DIMENSIONED  ARRAY  NECESSARY  ONLY  WHEN  NARY-1 . 
SPECIFING  A  SECOND  SIDE  OF  THE  BOUNDING  PARALLELOGRAM 
FROM  THE  POINT  SRCBAS< I  ) . THAT  IS  SIDE2  IS  A  VECTOR  TO 
TO  THE  NEXT  CHARGE  ALONG  THE  SECOND  SIDE  OF  THE 
PARALLELOGRAM. 

WHEN  NARY=2.  OR  3.  THIS  VARIABLE  SHOULD  NOT  APPEAR  ON 
THE  INPUT  FILE. 


RECORD 

LOCA 


COOR 


TSTAC 


DOUBLY  DIMENSIONED  ARRAY  CONTAINING  THE  DETONATION 
COORDINATES  FOR  EACH  CHARGE  WHEN  NARV=2.  OR  3 . .  WHEN 
NARY=1 .  THIS  VARIABLE  NEED  NOT  BE  SPECIFIED  AS  THE 
CHARGE  LOCATIONS  ARE  CALCULATED  IN  THE  CODE  FROM 
HCHS, SIDEl ,SIDE2. 


DRTOI 840 
DRT01850 
DRT01860 
DRT01870 
DRT01880 
DRT0t890 
DRT01900 
DRTOI 91 0 
DRT  01920 
DRT01930 
DRT01940 
DRT01950 


RECORD  7 
VEHC 

VO 


VEHDIR 


SINGLY  DIMENSIONED  ARRAY  CONTAINING  THE  TIME  OF  . . . 

DETONATION  OF  EACH  CHARGE.  THIS  IS  ONLY  SPECIFIED  WHEN  DRT01960 
NARV=3..  ORT01970 

ORT0t980 
DRT01990 
DRT  02000 
DRT 02 01 0 

DOUBLY  DIMENSIONED  ARRAY  CONTAINING  THE  INITIAL  DRT02020 
POSITION  OF  THE  VEHICLE.  V0< 1  )«X-COORDINATE  DRT02030 
VO<2>-Y-COORDINATE.  DRT02040 
VALID  RANGE:  -10000.0  -  10000.0  DRT02050 

DRT 02060 

VEHICLE  DIRECTION  THE  ANCLE  THAT  THE  VEHICLE  VELOCITY  DRT02070 
VECTOR  MAKES  WITH  THE  USER  S  POSITIVE  X-AXIS  MEASURED  DRT02080 
IN  DECREES  COUNTERCLOCKWISE.  WHERE  THE  USER'S  POSITIVE  DRT02090 
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VEH3PD 

VEHUID 

VEHUHT 

VEHTYP 


X-^XIS  POINTS  EAST,  THUS  VEHDIR  IS  THE  ANGLE  THE 
VELOCITY  VECTOR  MAKES  WITH  THE  EAST. 

VALID  RANGE:  -360.0  -  360,0 

VEHICLE  SPEED  IN  M/S 

VEHICLE  WIDTH  IN  METERS 

VEHICLE  WEIGHT  IN  KGS. 

TRACTION  MECHANISM 

•0,  VEHICLE  HAS  TIRES 
=t.  VEHICLE  IS  TRACKED 


RECORD  8 
TkNC 

TRNCOR  A  SINGLY  DIMENSIONED  ARRAY  CONTAINING  THE  THREE 

COORDINATES  OF  THE  TRANSMITTER.  THE  COORDINATE  SYSTEM 
MUST  BE  IN  METERS,  THE  THIRD  COORDINATE  IS  RESTRICTED 
TO  BE  BETWEEN  .5  AND  10000.0  METERS  <HEIGHT>, 

VALID  RANGE  OF  THE  FIRST  TWO  COORDINATES: 

-10000.0  -  1 0000.0  M. 

**  IF  THE  COORDINATES  ARE  PASSED  THROUGH  THE  GEOMET  OPTION,  THEN  THE 
**  ARRAY  TRNCOR  NEED  NOT  BE  SPECIFIED. 


TRNMIN 


RECORD  9 
RECC 

RECCOR 


VALUE  SUCH  THAT  A  TRANSMITTANCE  BELOW  THIS  VALUE  CAN 
BE  CONSIDERED  ZERO.  DEFAULT  IS  1.E-05 
VALID  RANGE:  1.0-1 ,E-05 


OBSCOR 


SPCHT 


A  SINGLY  DIMENSIONED  ARRAY  CONTAINING  THE  X  AND  Y 
COORDINATES,  RESP.,  OF  THE  OBSERVER.  <METERS) 

VALID  RANGE;  -10000.0  -  10000.0 

A  SPECIFIED  HEIGHT  IN  METERS  AT  WHICH  THE  WIDTH  OF 
THE  CLOUD  AS  VIEWED  FROM  POSITION  OBSCOR  IS  DESIRED. 
MUST  BE  BETWEEN  1 .  AND  5 .  METERS . 


DRT021 00 
DRT021 1 0 
DRT02120 
DRT  02130 
DRT02140 
DRT02150 
DRT02160 
DRT02170 
DRT  02180 
DRT021S0 
DRT02200 
DRT 0221 0 
DRT  02220 
DRT 02230 
DRT  02240 
DRT 02250 
DRT  02260 
DRT02270 
DRT  02260 
DRT02290 
DRT02300 
DRT0231 0 
DRT  02320 
DRT02330 


RECCOR  A  SINGLY  DIMENSIONED  ARRAY  CONTAINING  THE  THREE 
COORDINATES  OF  THE  RECEIVER.  < METERS) 

THE  THIRD  COORDINATE  IS  RESTRICTED  TO  BE  BETWEEN 
,5  AND  10000.0  METERS.  VALID  RANGE  OF  THE  FIRST  TWO 
COORDINATES  IS:  -10000.0  -  10000.0  M. 

**  IF  THE  COORDINATES  ARE  PASSED  THROUGH  THE  GEOMET  OPTION,  THEN  THE 
ARRAY  RECCOR  NEED  NOT  BE  SPECIFIED. 

RECORD  1 0 
OBSC 


DRT02340 
DRT02350 
DRT 02360 
DRT02370 
DRT 02380 
DRT  02390 
DRT02400 
DRT0241 0 
DRT02420 
DRT02430 
DRT02440 
DRT02450 
DRT02460 


DRT02470 
DRT02480 
DRT02490 
DRT02500 
DRT0251 0 
DRT02520 
DRT02530 
ORT02540 
DRT02550 
DRT02560 
DRT02570 


**  IF  THE  COORDINATES  ARE  PASSED  THROUGH  THE  GEOMET  OPTION,  THEN  THE 
>•<«  ARRAY  OBSCOR  AND  VARIABLE  SPCHT  NEED  NOT  BE  SPECIFIED. 


RECORD  11 
TIMS 

TSTART 


TIME  AFTER  DETONATION  TO  START  TRANSMITTANCE  AND/OR 
CLOUD  DIMENSION  CALCULAIONS 
VALID  RANGE:  .5  -  1000.0  SEC. 

TIME  AFTER  DETONATION  TO  TERMINATE  TRANSMITTANCE 
AND/OR  CLOUD  DIMENSIONS. 

VALID  RANGE:  .5-1000,0  SEC.  < TEND  MUST  BE  .GE.  TSTART) 
TIME  INCREMENT  BETWEEN  CALCULATIONS 


ORT02580 
DRT02590 
DRT02600 
DRT0261 0 
DRT02620 
DRT02630 
DRT02640 
DRT02650 
DRT02660 
DRT02670 
DRT02680 
DRT02690 
DRT02700 
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RECORD  12 

GO  ♦>»  THIS  ChRD  IHDIChTES  TH^T  THIS  SEQUENCE  OF  INPUTS  hRE 
COMPLETE  AND  CALCULATIONS  ARE  TO  BEGIN, 

lOPT  OPTION  TO  BE  USED 

1.  SIMULTANEOUS  BURST  , UNIFORMLY  DISTRIBUTED  CHARGES  IN  A 
PARALLELOGRAM 

2.  SIMUTANEOUS  BURST,  RANDOMLY  DISTRIBUTED  CHARGES 

3.  THE  CODE  IS  TO  PRECOMPUTE  A  SINGLE  CLOUD  AND  STORE  ON 
AN  EXTERNAL  FILE  FOR  USE  LATER 

4.  THE  CODE  IS  TO  USE  A  CLOUD  THAT  HAS  BEEN  PRECOMPUTED 
< NO  CLOUD  DIMENSIONS  ARE  COMPUTtu  FOR  THIS  OPTION; 

5.  VEHICLE  DUST  MODEL 

IFILE  FORTRAN  LOGICAL  UNIT  TO  WHICH  THE  CODE  IS  TO  WRITE  FOR 
OPTION  3  OTHERWISE  IT  NEED  NOT  BE  SPECIFIED 

RECORD  13 

DONE  THIS  RECORD  INDICATES  THAT  THE  USER  HAS  COMPLETED  HIS 
DESIRED  SEQUENCE  OF  INPUTS  AND  ALL  CALCULATIONS  ARE 
TERMINATED 


OUTPUTS 

2INV  THE  ESTIMATED  INVERSION  HEIGHT. 

TRNLOS  THE  TRANSMITTANCE  ALONG  THE  LINE  OF  SIGHT  BETWEEN 

THE  TRANSMITTER  AND  THE  RECEIVER, 

lERR  INTEGER  ERROR  CODE  WHICH  EQUALS  1  IF  A  FATAL  ERROR 

OCCURS  AND  0  OTHERWISE 

NERR  INTEGER  ERROR  CODE  WITH  THE  VALUES 

0  NO  ERRORS 

4  NO  TRANSMITTER  AND  RECEIVER  OR  OBSERVER 

COORDINATES  WERE  SPECIFIED  SO  NO  RESULTS  WERE 
CALCULATED. 

7  THE  CALCULATION  OF  ATMOSPHERIC  PARAMETERS  DID 
NOT  CONVERGE. 


CNTRD  A  SINGLY  DIMENSIONED  ARRAY  CONTAINING  THE  HORIZONTAL 

COORDINATE  AND  THE  VERTICAL  COORDIHATE  OF  THE 
CENTROID  OF  THE  CLOUD. 

HEIGHT  THE  HEIGHT  OF  THE  CLOUD  IN  METERS. 

CENWTH  THE  WIDTH  OF  THE  CLOUD  iM  METERS  AT  THE  CENTROID 
HEIGHT 

SPCWTH  THE  WIDTH  OF  THE  CLOUD  IN  METERS  AT  THE  SPECIFIED 
HEIGHT 

NCPTS  THE  NUMBER  OF  POINTS  DETERMINED  ON  THE  EDGE  OF  THE 

CLOUD . 

CRTS  A  DOUBLY  DIMENSIONED  ARRAY  CONTAINING  THE  COORDINATES 

OF  POINTS  ON  THE  EDGE  OF  THE  CLOUD.  CPTS<1,J) 

IS  THE  HORIZONTAL  COORDINATE  OF  THE  J-TH  POINT 
AND  CPTS<2,J)IS  THE  VERTICAL  COORDINATE  OF  THE 
J-TH  POINT.  THE  FIRST  INDEX  MUST  BE  DIMENSIONED 
TO  2. 


DkT0271 0 
DRT(j2720 
DRT  02730 
DRT  02^-4  0 
DRT  027t>0 
DRT  02760 
DRT02770 
DRT  02780 
DRT02790 
DRT 028 00 
DRT  02’&  i  0 
DRT02820 
DRT  0283  0 
DRT  0284  0 
DRT  u23sO 
DRT  0286  0 
DRT  028 0 
DRT  0288  0 
DRT  0289  0 
DRT  028  0  0 
DkT  0281 0 
DRT02820 
DRT  0283  0 
DRT 02840 
DRT  02850 
DRT  0286  0 
DRT02870 
DRT  02880 
DRT  02880 
DRT03000 
DRT  0301 0 
DRT03020 
DRT  03030 
DRT 03 040 
DRT  03050 
DRT  03060 
DRT  03070 
DRT 03 080 
DRT  0308  0 
DRT  03100 
DRT031 1 0 
ORT03120 
DRT 03 130 
DRT03140 
DRTU3150 
DRT03160 
DRT031 70 
DRT 03  ISO 
DRT03180 
DRT 032 00 
DRT 0321 0 
DRT  0322  0 
DRT03230 
DRT03240 
DRT03250 
DRT  03260 
DRT03270 
DRT03280 
DRT03280 
DRT03300 
DRT0331 0 
DRT  03320 
DRTU3330 
DRT03340 
DRT  0335  0 
DRT03360 
DRT03370 
DRT03380 
DRT03390 
DRT03400 
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SUBROUTINES  CALLED 


DU3TCL 


COMP CL 


VEHCL 


[NES  CALLED  DRT0341 0 

DRT03420 

CONTROLIHG  ROUTINE  FOR  THE  CALCULATION  OF  CLOUD  DIMENSIOHSDRT03430 
AND  TRANSMITTAHCE3  THROUGH  DUST  CLOUDS  FOR  OPTIONS  t  AND  2DRTu3440 
GIVEN  METEORLOGICAL  DATA.  SOIL  AND  EXPLOSIVE  DRT0345o 

CHARACTERISTICS. AND  WAVELENGTH.  DRT03460 


DRT0345O 
DRT03460 
DRT03470 
DRT 03480 
DRT  03490 


CONTROLIHG  ROUTINE  FOR  PRECOMPUTING  A  SINGLE  EXPLOSION  DRT03480 
(OPTION  3i  GIVEN  METEOROLOGICAL  DATA.  SOIL  AND  EXPLOSION  DRT03490 
CHARACTERISTICS,  ALSO  USES  THIS  PRECOMPUTED  CLOUD  AT  SOMEDRT03500 
LATER  RUNNING  OF  THE  CODE  (OPTION  4>  TO  ESTIMATE  A  DRTu3510 
TRANSMITTANCE  GIVEN  TRANSMITTER  AND  RECEIVER  COODINATES.  DRT03520 

DRT03530 

CONTROLIHG  ROUTINE  FOR  THE  CALCULATION  OF  A  TRANSMITTANCE  DRTD3540 
THROUGH  A  VEHICLE  GENERATED  DUST  CLC'D  (OPTION  5>  GIVEN  DRT03550 
METEORLOGICAL  DATA.  SOIL  CHARACTERISTICS.  VEHICLE  DRT0356Ci 
CHARACTERISTICS.  AND  WAVELENGTH.  DRT03570 


THROUGH  A  VEHICLE  GENERATED  DUST  CLC'D  (OPTION  5>  GIVEN  DRT03550 

METEORLOGICAL  DATA.  SOIL  CHARACTERISTICS.  VEHICLE  DRT0356Ci 

CHARACTERISTICS.  AND  WAVELENGTH.  DRT03570 

DRT03580 

LOGICAL  NEWATM.NEWSRC.LOSTRN.EDGE.NEWTIM.  CLMRED . DHDT . ONCE  DRT036U0 

LOGICAL  TEST.NEWVEH.NEWCOR  DRT036tO 

LOGICAL  Ml  ,M2,SL,CH.EX,TC.RC,0C.,TM.VH  DRT03620 

INTEGER  VEHTYP  DRT03630 

REAL  M.N 

DIMENSION  ZTMP( 2  ), TMPMES( 2  ). ZWND( 2  >, WNDMES( 2  >, TRNCOR( 3  >  DRT 0364  0 

DIMENSION  SRC8AS(2>,SIDE1(2).SIDE2(2).NCHS(2)  DRT03650 

1  .RECC0R<3>.CPTS<2,6).CNTRD(2).0BSC0R(2>  DRT03660 

DIMENSION  RDIN(  1  0),Rt(EY(  12),V0(2>.PAS(6)  DRT03670 

COMMON  XIOUNITXIOIN, lOOUT, IPHFUN. LOUNIT. NDIRTU. NCLIMT. KSTOR. NPLOTUDRT03680 
COMMON  XCLYMATX  TEMP . PRESS , RH , AH , DP , VIS. CLDAMT , CLDHYT .  DRT03690 

1  FOGPRB.WNDVEL.WINDIR, IPASCT  DRT03700 

C0MM0NXM05XDIFF( 2. 200 ), NCHTOT , PRSEP( 200 ), NTOT, NARY, ITOT,  DRT 0371 0 

+  COOR(2.200>.TSTAG(200),DMMY(401 )  DRT03720 

COMMON/WNDPRM/DXZO , DYX 0 , DZO , UO , M . N, Z INV  DRT  0373 0 

COMMONXTRANNY/'THRESH.TEST.NUIL.NSOIL  DRT03740 

C0MM0NXGE0MXC0STH2. SINTH, SINTH2, VISEXT.RTPI , SCRN(2 )  DRT 0373 0 

COMMON  /GEOMET/PTS( 15). IGEOSW  DRT03760 

COMMON/OPTIONXIOPT. IFILE  DRT03770 

DATA  RKEY/4HMET1 ,4HMET2.4HS0IL.4HCHAR,4HEXPL. 4HVEHC,4HTRNC.  DRT 03780 

1  4HRECC.4H0BSC,4HTIMS,4HG0  , 4HD0NEX  DRT03790 

DATA  PASX4HA  ,4HB  , 4HC  .4HD  , 4HE  . 4HF  X  DRT03800 

DATA  Ml .M2.SL.CH,EX.TC,RC,0C.TM,VHX.FALSE. , .FALSE. , .FALSE. ,  DRT 0381 0 

1  .FALSE .  .  .FALSE . .  .FALSE . .  .FALSE. ,  .FALSE. ,  .FALSE . ,  .FALSE ./  DRT 0382  0 

DATA  NEWATM.NEWSRC.NEWVEH.LOSTRN. EDGE, NEWTIMX, FALSE, , .FALSE, ,  DRT0383CI 

1 .FALSE. , .FALSE. . .FALSE. , .FALSE./  DRT 03840 

DATA  NEWCOR/. FALSE,/  DRTC38S0 

DATA  VISEXT.RTPI/. 1 , 1 , 772454/  DRT03S60 

IERR=0  DRT03870 

CLMRED= .FALSE .  DRT03880 

OHDT=, FALSE.  DRT03890 

ONCE=. FALSE.  DRT03900 

TEST*. FALSE.  DRTOSSIO 

WRITE< IOOUT.800)  DRT03920 

800  FORMAT< 1H0.36X.42HOIRTRAN-2  OUST  CLOUD  INFRARED  TRANSMISSION,  ORT03930 

1  15H  CALCULATION. //.36X. eOH+xo*  NOTE  —  ALL  UNITS  ARE  MKS  UNLESSDRT 0394 0 

2  OTHERWISE  SPECIFIED  ***.//)  DRT03950 


DO  5  K=1 ,200 
TSTAG<K>=0.  0 
5  CONTINUE 

DETERMINE  INTEGER  INDEX  FOR  WAVELENGTH 

10  IFCWAVEI .LT , 0,4jGO  TO  29 
IF(WAVE1 .GT. 0,7)GO  TO  21 
NWL=1 
GO  TO  30 

21  IF(WAVE1 .LT. 0.8)CO  TO  29 
IF(WAVE1 ,GT. 1 . 1 )GO  TO  22 
NWL»2 
GO  TO  30 


DRT03960 
DRT03970 
DRT03930 
ORT03990 
DRT 04 000 
DRT0401 0 
DRT04020 
DRT04030 
DRT04040 
DRT04050 
DRT04060 
DRT04070 
DRT040d0 
DRT04090 
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22  IF<UAVE1 .LT.3.5)G0  TO  29 
IFCUAVEI .GT.4. 0)GO  TO  23 
NtJL=3 

GO  TO  30 

23  IF<WAVE1 .LT.8.5)G0  TO  29 
IF<UAVE1 .GT . 12. 0)GO  TO  24 
MUL=4 

GO  TO  30 

24  IF<  uittVEI  .  LT  .  21  00  .  >G0  TO  29 
IF<WrtVE1 .GT.3200.  >GO  TO  29 
NUL=5 

GO  TO  30 

29  iJKlTE<  lOOUT,  802  j 

802  F0RMftT<37X,3eH***  DIRTRAN  ERROR  -  WAVE1  OUT  OF  RANGE) 
IERR=1 
GO  TO  999 

30  CONTINUE 

READ  DATA  AND  STORE  APPROPRIATELY 


DRT041 00 
DRT041 1 0 
DRT04120 
DRT04130 
DRT04140 
DRT04150 
DRT04160 
DRT04170 
DRT  04180 
DRT04)90 
DRT  04200 
DRT0421 0 
DRT  04220 
DRT04230 
DRT04240 
DRT04250 
DRT  04260 
DRT04270 
DRT  04280 


DO  300  11=1 ,15 

IF< II .EQ. 15)G0  TO  900 

READ<.  lOIN,  700)<RDIH<  J  J,  J=1  , 1  0) 

700  F0RMAT<A4,4X,9F8.2) 

IF<RDIN< 1 >.EQ,RKEY< 1 ))GO  TO  50 
IF(RDIN< 1  ).Ee,RKEY<2))G0  TO  70 
IF<RDIN< 1 >.EQ,RKEY<3> jGO  TO  90 
IF<RDIN<  1  >.EQ,RKEY<4:))G0  TO  1 1  0 
IF<RDIN< 1 >.E6,RKEY<5)>G0  TO  130 
IF<RDIN< i ).EQ,RKEV<6>>G0  TO  150 
IF<RDIN< 1  ).EQ.RKEY<7>)G0  TO  170 
IF<RDIN< 1 >.EQ,RKEY<8))G0  TO  190 
IF<RDIN< 1 i,EG,RkEy<9)iG0  TO  210 
IF<RDIN< 1  ).EQ,RKEY< 1 0>>GO  TO  230 
IF<RDIN<  r).EQ,RkEY< 1 1 >)GO  TO  310 
IF<RDIN< 1 ).EQ,RKEY< 12)>G0  TO  999 
URITE< IOOUT,804) 

804  F0RMAT<33X,52Ht<>»'»'DIRTRAN-2  ERROR,  INPUT 
1  14H  CONVENTION***) 

WRITE<  IOOUT,S06:><RDIN<  J),  J=1 ,9) 

806  F0RMAT<26X,A4,4X,9F8.2> 

GO  TO  999 

STORE  AND  PRINT  OUT  ATMOSPHERIC  CONDITIONS 

50  CONTINUE 
Ml =. TRUE. 

NI0=1 

rF< ICLHAT.EQ. 1 )GO  TO  55 
NATM03=IF1X<:RDIN<2)> 

ZTMP<  1  )=RDIN<3) 

TMPMES< 1 )=RDIN<4> 

ZWND< i  )=RDIN<5) 

UNDMEO< 1  )=RDIN<6) 

THWND=RDIN<7) 

GO  TO  60 


INPUT  DOES  NOT  CONFORM  TO 


IP3CAT  PASQUILL  CATEGORY 

UNDVEL  WIND  VELOCITY  IN  M/’S  MEASURED  AT  2  M .  ABOVE  GROUND 
UINDIR  UIND  DIRECTION  IN  DEGREES  CLOCKUISE  FROM  TRUE  NORTH 

TEMP  TEMPERATURE  IN  DEGREES  C  MEASURED  AT  2  M.  ABOVE  GROUND 

55  NATMOS=IPASCT 
ZTMP< 1 )=2, 

2UND< 1 >*2. 

UNDMES< 1 )»WNDVEL 
TMPMES< 1 >=TEMP+273. 0 
THWND»270, 0-WINDIR 
60  CONTINUE 

WRITE< 100UT,808> 


DRT  04290 
DRT04300 
DRT0431 0 
DRT  04320 
DRT04330 
DRT04340 
DRT04350 
DRT04360 
DRT04370 
DRT  04380 
DRT04390 
DRT  04400 
DRT0441 0 
DRT04420 
DRT04430 
DRT04440 
DRT 04450 
DRT  04460 
PROPERDRT04470 
DRT04480 
DRT04490 
DRT04500 
DRT0451 0 
DRT  04520 
DRT04530 
DRT  04540 
DRT04550 
DRT04560 
DRT04570 
DRT  04580 
DRT04590 
DRT  04600 
DRT 0461 0 
DRT  04620 
DRT04630 
DRT04640 
DRT04650 
DRT  04660 
DRT04670 
DRT04680 
DRT04690 
DRT04700 
DRT0471 0 
DRT04720 
DRT04730 
DRT04740 
DRT04750 
DRT04760 
DRT04770 
DRT047e0 
DRT04790 
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J0«  FORMAKIX) 

U)RITE<  I00UT,81  0>PAS<  NATH03  ) 

810  FORMAT<50X,28HPASQUILL  CPTEGORY  , A4 ) 

WRITE<  I00IJT.812><ZTMP<  I  ),TMPMES<  I  ),ZUND<  I  >,UNDMES<  I  >,  I»t  ,NI0> 

812  FORMATC 36X, 4H  HT  ,Fe.2,7H  TEMP  .F8.2,7H  HT.F8.2,7H  WIND  , 

1  F8.2> 

UIRITE<  luOUT.  814  >THu)ND 

814  F0RMAT<51X,22H  WIND  DIRECTION  , F8 . 2  ) 

GO  TO  300 
70  CONTINUE 
M2= . TRUE . 

ID=IFIX<RDIN<2>> 

IFc ID.NE.O>DHDT=.TRUE. 

PHI=RDJN<3> 

WkI  I  EC  lOOUT,  819  .>PH1 
IFCDHDTiWRITEC I00UT,816) 

816  F0RMAT<47X,37HTHE  INVERSION  LAYER  HEIGHT  IS  GROWING > 

IF< .NOT ,DHDT>WRJTE< 100UT,818) 

318  F0RMATC47X,38HTHE  INVERSION  LAYER  HEIGHT  IS  CONSTANT) 

819  FORMAT</,52X,20HLATITUOE  , F8 . 2 > 

GO  TO  300 

STORE  AND  WRITE  SOIL  CHARACTERISTICS 

90  CONTINUE 
SL=,TRUE. 

NS0IL=IFIX<RD1N<2)> 

DS0D=RD1N<3) 

3ILT-RDIN<4> 

IFCNSOIL.EQ. 1  )«R1TE< I00UT,821 > 

820  FORMATCSeX, 15HSILT  CONTENT  ,F5.2> 

821  F0RMAT<X,63X,6HS0IL-1 > 

IFCNSOIL.EQ. 2)UR1TE< I00UT,822) 

82.2  F0RWAT<X,63X,6HS0IL-2) 

IF  <NS0IL.EQ.3)  WRITE  <IOOUT,710> 

10  F0RMATCX,23X.8H  SOIL-3) 

IFCSILT .GT. 1 .E-06)WR1TEC lOOUT, 820 )SILT 
WRITEC 100UT,823)DS0D 

823  F0RMAT<53X,21H  DEPTH  OF  SOD  ,F5.2) 

IF  CNSOIL.LT. 1 .0R.NS0IL.GT.2)  NS0IL=2 

GO  TO  300 

STORE  AND  WRITE  EXPLOSIVE  CHARGE  CHARACTERISTICS 

110  CONTINUE 
CH—  TRUE 

NCHRG=IFIX<RDIN<2)) 

IFCNCHRG.LT. 1  . OR . NCHRG . GT , 5  )NCHRG=1 
CHWT=RDIN<3> 

DETDEP*RDIN<4 ) 

IFCNCHRG.EQ. 1  )WRITE< I00UT,824> 

824  F0RMAT<X,35X,47HSURFACE  -  LIVE  FIRE  OR  30  DEGREE  TILTED  STATIC,, 

I  14H  TIP  ON  GROUND) 

IFCNCHRG.EQ  2  )WR1TEC lOOUT, 82S ) 

825  FORriAT</,55X,22HBARE  CHARGE  OH  SURFACE) 

I F<  NCHRG . EQ , 3 )WR 1  TEC lOOUT , 826  ) 

826  FORMATC/,46X,39H30  DEGREE  TILTED  TIP  AT  0.3  METER  DEPTH) 

1F<  NCHRG . EQ . 4 )UR1TEC lOOUT , 827  ) 

827  FORMATC/’,46X,39H30  DEGREE  TILTED  TIP  AT  0.6  METER  DEPTH) 
IFCNCHRG.EQ. 5)WRITEC I00UT,828) 

828  FORMATCX,50X,32HHOR1ZONTAL  PROJECTILE  ON  SURFACE) 

WRITEC I00UT,829)CHWT 

829  FORMATC45X,30HWEIGHT  OF  CHARGE  ,F8.2,4H  KG.) 

WRITEC IOOUT,830)DETDEP 

830  FORMATC47X,30HDETONATION  DEPTH  ,F8.2) 

GO  TO  300 

STORE  AND  WRITE  OUT  INFORMATION  ABOUT  THE  DETONATION  LOCATIONS 
130  CONTINUE 


DRT04e00 
DRT04ei 0 
DRT04820 
DRT04830 
ORT04840 
DRT04850 
DRT  04860 
DRT04870 
DRT04880 
DRT04890 
DRT  04900 
DRT 0491 0 
DRT  0“920 
DRT04930 
DRT  04940 
DRT04950 
DRT04960 
DRT 04970 
ORT04980 
DRT04990 
DRT05000 
DRT0501  0 
DRT05020 
DRT  05030 
DRT  05040 
DRT 05 050 
DRT  05060 
DRT05070 
DRT  05080 
DRT05090 
DRT051 00 
DRT051 1 0 
DRT05120 
DRT05130 
DRT0S140 
DRT05150 
DRT05160 
DRT05170 
DRT05180 
DRT05190 
DRT  05200 
DRT0521 0 
DRT05220 
DRT05230 
DRT0524U 
DRT05250 
DRT05260 
DRT05270 
DRT05280 
DRT05290 
DRT05300 
DRT 0531 0 
DRT05320 
ORT05330 
DRT 05340 
DRT05350 
DRT05360 
DRT 05370 
DRT05380 
DRT 05390 
ORT05400 
DRT0541 0 
DRT05420 
DRT05430 
DRT05440 
DRT05450 
DRT 05460 
DRT05470 
DRT05480 
DRT05490 
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EX=.TRUE. 

NARY=IFIX<RDIN<2)> 

NCHS<  1  )=ifix<:rdin<3j> 

NCHS<2)=IFIX<RD1N<4)) 

SRCBAS< 1 >«RDIN<5> 

SRCBAS<2)=RDIN<6> 

SIDEU  1  >=RDIN<7J 
SIDEK2>=RDIN<8> 

S1DE2<  1  >«R&IN<9> 

SIDE2<2>=RD1N< 1 0> 

IF<NARY,EQ.2>G0  TO  133 
IF<.NARY.EQ.3)G0  TO  136 

CHARGE  DISTRIBUTION  TYPE  1 

WRITE< I00UT,631 > 

831  F0RMAT<X,31X,42HS1MULTANE0US  BURST  ,  UNIFORMLY  DISTRIBUTED, 

+27H  CHARGES  IN  A  PARALLELOGRAM > 

NCH=NCHS< 1 j*NCHb<2) 

WRITE< IOOUT,832>NCH,<SRCBAS< I >,  1  =  1 ,2) 

832  FORMAT< 27X,28HT0TAL  NUMBER  OF  CHARGES  IS  , IX, 13, IX, 

+27H  WITH  REFERENCE  CHARGE  AT  < , F8 . 2, 1 H , , F8 . 2 , 1 H ) > 

WRITE< I00UT,834>NCHS< 1  ),<S1DE1< I  ), 1  =  1,2) 

834  F0RMAT<32X, 13, 1X,45Ht.HARGES  WITH  DIRECTION  AND  SPACING  GIVEN  BY  < 
^F6  >2  1 H  F8  «  2  1 H ) ) 

WRiTEC  i66iJT^834)NCHS<2),<S1DE2<  I  >,  1-1 ,2) 

GO  TO  300 

CHARGE  DISTRIBUTION  TYPE  2 

133  NCH=NCHS<1> 

DO  134  J=1,NCH 

REAO<  IOIN,701  )<COOR<K,  J),K-1 ,2) 

701  F0RMAT<8X,2F8.2) 

134  CONTINUE 
WRITE<  I00UT,836:> 

836  F0RMAT<7,42X,48HSIMULTANE0US  BURST,  RANDOMLY  DISTRIBUTED  CHARGES) 
WRITE< 100UT,838)NCHS< 1 ) 

838  F0RMAT<51X,26HT0TAL  NUMBER  OF  CHARGES  IS  ,1X,I3  ) 

WRITEC IOOUT,840 ) 

840  F0RMAT<55X,22HDET0NATI0N  COORDINATES) 

DO  135  J-1,NCH 

WRITE< I00UT,842  )< COOR< I , J), 1  =  1 ,2) 

842  F0RMAT<53X,2<3X,F8.2)) 

135  CONTINUE 
GO  TO  300 

CHARGE  DISTRIBUTION  TYPE  3 

136  NCH=NCHS<1) 

DO  137  J=1,NCH 

READ< lOIN, 702  )<COOR<  K, J ), K-1 , 2 ), TSTAG<  J ) 

702  F0RMAT<8X,3F8.2) 

137  CONTINUE 
WRITER I00UT,844> 

844  FORMAT<:/,30X,38HSEQUEHTIAL  IN  TIME  AND  RANDOM  IN  SPACE, 

424H  DISTRIBUTION  OF  CHARGES) 

WRITEC 100UT,838)NCH 
WR1TE< 100UT,846> 

846  F0RMAT<45X,25H  DETONATION  COORDINATES  ,7X,10HBLAST  TIME) 

DO  138  J-1,NCH 

WRITE< I00UT,848)<C00R< I, J), I-l , 2 > , TSTAG<  J ) 

848  F0RMAT<46X,F8.2,3X,Fe,2, 12X,F8.2) 

138  CONTINUE 
CD  TO  300 

STORE  AND  PRINT  OUT  INFORMATION  ABOUT  VEHICLE 

150  CONTINUE 
VH-.TRUE. 


DRT05500 
DRT0551 0 
DRT 05520 
DRT05530 
DRT05540 
DRT0555C 
DRT05560 
DRT05570 
DRT 05580 
DRT05590 
DRT05600 
DRT  0561  0 
DRT05620 
DRT 05630 
DRT 05640 
DRT 05650 
DRT 05660 
DRT05670 
DRT05680 
DRT05690 
DRT 05700 
DRT0571 0 
DRT05720 
,  DRT05730 
DRT05740 
DRT05750 
DRT05760 
DRT05770 
DRT05780 
DRT 05790 
DRT05S00 
DRT0581 0 
DRT05820 
DRT 05830 
DRT05840 
DRT05850 
DRT05660 
DRT05870 
DRT05880 
DRT05890 
DRT05900 
DRT 0591 0 
DRT05920 
DRT05930 
DRT 05940 
DRT05950 
DRT05960 
DRT05970 
DRT05980 
DRT05990 
DRT06000 
DRT0601 0 
DRT06020 
DRT06030 
DRT06040 
DRT06050 
DRT06060 
DRT06070 
DRT 06 080 
DRT06090 
DRT061 00 
DRT 061  1  0 
ORT06120 
DRT06130 
DRT06140 
DRT06t50 
DRT06160 
DRT06170 
DRT 061 80 
DRT06190 
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POSITION  < ,F8.2, 1H, ,F8.2, 1H)> 
,F8.2,t7H  <CCU  FROM  ERST)) 
,F8.2,4H  M/'S) 

,F8.2> 

,F8,2) 


V0<  1  )=RDIN<2> 

V0<2>=RDIN<3> 

VEHDIR=RDIN<4) 

VEHSPD=RDIN<5) 

VEHUID»RDIN<6> 

VEHWHT=«RDrN<  7) 

VEHTVP=IFIX<RD1H<8 )) 

WRITEC IOOUT,850)VO< 1 >,V0<2> 

850  F0RMftT</’/',44X.26HINITIRL  VEHICLE 
WRITE< IOOUT>  852 )VEHDIR 
852  FORMRTC 44X, 19HVEH1CLE  DIRECTION 
URITE<  I00LIT,854>VEHSPD 
854  FORMAT<:50X,20HVEHICLE  SPEED 
WRITE< I00UT,856)VEHWID 
856  FORMAT«:52X.20HVEHICLE  WIDTH 
URITE< I00UT,858)VEHWHT 
858  FORMAT<52X,20HVEH1CLE  WEIGHT 

IF<VEHTYP.EQ. 0)WR1TE< I00UT,891  ) 

89J  F0RMftT(58X, 15HWHEELED  VEHICLE) 

IF<VEHTYP.EQ. 1  )WRITE< I00UT,892) 

892  F0RMAT<58X, 15HTRPCKED  VEHICLE) 

GO  TO  300 

STORE  TRANSMITTER  COORDINATES  AND  TRANSMISSION  TRHESHOLD 

170  CONTINUE 
TC= . TRUt . 

NEWCORa , TRUE . 

TRNCOR< 1  )=RDIN<2> 

TRNC0R<2>=RDIN<3> 

TRHC0R<3)=RDIN<4) 

TRNMIN=RDIN<5) 

IF<TRNMIN.LT. 1 . E-05 )TRNMIN«1 .E-05 
THRESH=-ALOG<  TRHMIN ) 

GO  TO  300 

STORE  RECEIVER  COORDINATES 

190  CONTINUE 
RC=,TRUE. 

RECC0R<  1  )=«RDIN<2> 

RECC0R<2>=RDIN<3) 

RECCCR<3)=RDIN<4) 

GO  TO  300 

STORE  OBSERVER  COORDINATES 

210  CONTINUE 
OC=.TRUE. 

OeSCOR< 1 )«RDIN<2 ) 

OBSCOR<2)=RDIN<3) 

SPCHT=RDIN<4> 

GO  TO  300 


STORE  TIME  INTERVAL  FOR  CALCULATIONS 

230  CONTINUE 
TM«.TRUE. 

TSTART=RD1N<2) 

TEHD=RDIN<3> 

TINC=RDIN<4) 

IF  <TINC.LE.0.0)  TINC-1 . 
IF<TEND.LT.TSTART)CO  TO  903 
LIM=IFIX<  <  TEND-TSTART  )/'TINC  )+1 
300  CONTINUE 
310  CONTINUE 

IF< IGEOSU.NE. 1 >  GO  TO  333 
TRNCOR< 1 )*PTS< 1 )f1 000 , 
TRNC0R<2)=«PTS<2)'*1  000. 

TRNCOR<  3  >«PTS<  3  >*1  000 . 


DRT06200 
DRT0621 0 
DRT 06220 
DRT 06230 
DRT  06240 
DRT06250 
DRT  06260 
DRT06270 
DRT06280 
DRT06290 
DRT06300 
DRT 0631 0 
DRT06320 
DRT06330 
DRT06340 
DRT06350 
DRT06360 
DRT06370 
DRT06380 
DRT06390 
DRT06400 
DRT0641 0 
DRT  06420 
DRTC6430 
DRT  06440 
DRT  06450 
DRT  06460 
DRT06470 
DRT  06480 
DRT06490 
DRT 065 00 
DRT 0651 0 
DRT06520 
DRT06530 
DRT06540 
DRT06550 
DRT06560 
DRT06570 
DRT06580 
DRT06590 
DRT  06600 
DRT0661 0 
DRT06620 
DRT06630 
DRT06640 
DRT06650 
DRT  06660 
DRT06670 
DRT06680 
DRT06690 
DRT06700 
DRT0671 0 
DRT 06720 
DRT06730 
DRT06740 
DRT06750 
DRT06760 
DRT06770 
DRT06780 
DRT06790 
DRT06800 
DRT0681 0 
DRT 06820 
DRT06d30 
DRT06840 


DRT06350 

DRT06860 

DRT06870 

DRT06880 
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RECCOk<  1  >*PTS<  4  >H>1  000  . 

RECC0R<  2  )=PTS<  5  000 . 

RECC0R<  3  )=PT3<  6  >f1  000  . 

0BSC0R< 1  )=PTS< 1 0  )*i  000. 

0BSC0R<2>»PT3< 1 1 >f1000. 

SPCHT=PTS< 12>*1 000. 

333  CONTINUE 

I0PT=IF1X<RDIH<2>) 

IFILE»IFIX<RD1N<3>> 

IF< 10PT.NE.3)  GO  TO  305 
URITE<  IClOUT,301  ) 

WR1TE< 100UT,302> 

«RITE< IOOUT,303)  IFILE 
UR1TE< IOOUT,304) 

WR1TE< 100UT,301  ) 

301  FORMAT<  1H0,  130<  lH*),/> 

302  FORMAT<  1H0,58X,  15H01RTRPN  WARNING,/') 

303  FORMAT< 1H0,38X, 13HL0G1CAL  UNIT  ,I2,27H  IS  ASSIGNED  TO  A  TEMPORARY, 
+  13H  STORAGE  FILE) 

304  FORMAT< 1H0,28X,46HCARE  MUST  BE  TAKEN  TO  INSURE  THAT  THIS  UNIT  IS, 
t-27H  NOT  IN  USE  BY  ANOTHER  FILE,,') 

305  CONTINUE 

IF<<:  lOPT.EQ.  1  .0R.I0PT.EQ.2).AHD.<EX.AND.<  .N0T.CH)))GO  TO  909 
IF<< lOPT.EQ. 1 .OR. 10PT.EC.2>.AN&.<CH.AND.< .NOT,EX>)>GO  TO  909 
I F<  < I OPT . EQ . 3  )  . AND . OC )OC“ . FALSE . 

IF<  < lOPT . EQ . 4  )  . AND . OC  >OC= . FALSE . 

IF<  < lOPT . EQ . 5  > . AND . OC )OC= . FALSE . 

IF<<TC.AND.< .NOT.RC)).OR.<RC.AND.< .NOT.TC>))GO  TO  913 
I F<  M 1 .  OR . M2 )NEUATM- . TRUE . 

1  F< 1 OPT . EQ . 3 . AND , CH )NEWSRC= . TRUE . 

IF<  EX . AND , CH  )NEWSRC= . TRUE . 

IF<  TC . AND , RC )LOSTRN= . TRUE . 

IFCOC  )EDGE*= .  TRUE . 

IF<VH)NE«VEHn.TRUE. 

IF<I0PT,EQ.3)LIM=1 
DO  400  J*1 ,LIM 
TlME=TSTART+TINC>»FLOAT<  J-1  ) 

NEWT1M=.TRUE. 

NERR=0 

IF< lOPT.EQ. 1 .OR, I0PT.EQ,2)G0  TO  320 
1F< 10PT.EQ.3.0R. I0PT.EQ.4)G0  TO  325 
IF<< lOPT.EQ. 1  ).AND.<NARY,HE. 1 >)CO  TO  915 
IF<< lOPT.EQ .2).AND.<NARY.NE.2>>G0  TO  915 
IF<< lOPT.EQ. 4). AND. < NARY. NE. 3) )GO  TO  915 

COMPUTE  FOR  VEHICLE  SOURCE 

CHECK  TO  SEE  IF  WE  HAVE  THE  MINIMUM  INPUT  REQUIREMENTS 
1F<DS0D.GT. 0. 0>GO  TO  315 

IF< ,NOT.<Ml .AND.M2.AND.SL.AMD.VH.AND.TC.AND.RC.AND.TM))G0  TO  91 1 
CALL  VEHCL< NATMOS, ZTMP , TMPMES, ZWND, WNDMES , THWND, PHI , NSOIL, 

1  SILT,NWL^TRNCOR,RECCOR,TIME,DHDT, V0,VEHDIR, 

2  VEHSPD , VEHW I D , VEHWHT , VEHTYP , NEMATM , NEWVEH , TRNLOS , NERR ) 
NEUVEH=.FALSE. 

NEWATMa. FALSE. 

GO  TO  330 
315  TRHL03*1 . 0 
Go  TO  335 
325  CONTINUE 

IF<10PT.EQ.4.AND.< .NOT.<EX,ANO.TC,AND.RC.AND.TM)>>GO  TO  911 
IF<10PT.E0.3.AND.< .N0T.<M1 .AND.M2.AHD.8L.AND.CH>))C0  TO  911 
CALL  COMPCL<NEUATM, NATMOS, ZTMP,TMPMES, ZWND, WNDMES, THWND, 

1  PHI , NEWSRC , CHWT , NCHRG , NCHS , DETDEP , NSO I L , DSOD , NWL , 

2  TRNCOR , RECCOR , T 1 HE , DHDT , TRNLOS , NERR  > 

NEW3RC». FALSE. 

NEWATM=. FALSE. 

IF< lOPT.EQ. 3 )GO  TO  4 1 0 
GO  TO  .130 
320  CONTINUE 


DRT  06890 
DRT06900 
DRT  0691 0 
DRT06920 
DRT06930 
5rT06940 
DRT06950 
DRT 06970 
DRT 06980 
DRT 06990 
DRTOi-  OOO 
DRT0701 0 
DRT07020 
DRT07030 
DRT07C40 
DRT07050 
ORT07060 
DRT0P070 
DRT07030 
DRT07090 
DRT071 00 
DRT071 1 0 
DRT07120 
DRT 07 130 
DRT07i40 
DRT07150 
DRT  07 160 
DRT07170 
DRT07180 
DRT07190 
DRT07200 
DRT0721 0 
DRT07220 
DRT07230 
DRT07240 
DRT07250 
DRT 07260 
DRT07270 
DRT07280 
DRT07290 
DRT07300 
DRT0731 0 
DRT07320 
DRT07330 
DRT07340 
DRT07350 
DRT07360 
DRT07370 
DRT  07380 
DRT07390 
DRT07400 
DRT0741 0 
DRT07420 
DRT07430 
DRT07440 
DRT07450 
DRT07460 
DRT07470 
DRT07480 
DRT07490 
DRT07500 
DRTU751 0 
DRT07520 
DRT07530 
DRT07540 
DRT  07550 
DRT07560 
DRT07570 
DRT07580 
DRT07590 
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CHECK  TO  SEE  IF  MINIMUM  INPUTS  ARE  AVAILABLE 

I F<  ,  NOT , <  M 1 . AND . M2 . AND . SL . AND . CH . AND . EX . AND . <  TC . AND . RC , OR , OC  > . AND 
( TM  >  )GO  TO  9i 1 

CALL  DUSTCLC  NEWATM , NATMOS, 2TMP , TMPMES, 2UHD, WNDMES, PHI , 

1  THUND , NEUSRC , CHUT , NCHRG , DETOEP , NSO I L , OSOD , 

2  LOSTRN, TRNCOR,RECCOR.EOGE,OBSCOR. SPCHT.NEUTIM, 

3  TIME,TRNL0S,CNTRD,HE1GHT,CENWTH,SPCUTH,NCPTS,CPTS, 

4  NERR.NCHS,SRCBAS,SIDEf ,SIDE2,DHDT  > 

NEU3RC= .FALSE . 

NEWATM=, FALSE. 

330  IFCNERR.EQ. 0>GO  TO  335 
WRITEC I00UT,857 jNERR 

857  FORMAT<55X,30H  •••■*■*  +  >*  DIRTRAN  ERROR  NUMBER  ,I2> 

GO  TO  400 

335  IF< ONCE. AND. < .NOT. NEUC0R>>G0  TO  340 
NEWCOR=. FALSE. 

IZINV=IFIX<2INV> 

URITEC IuOUT.SSSjIZINV 

859  FORMAT' XX, 47X, 30HESTIMATED  INVERSION  HEIGHT  ,I7> 

IF  ObSERVER  IS  SPECIFIED,  OUTPUT  IS  LABELED  FOR  EACH  TIME. 

IF  ONLY  TRANSMITTER  AND  RECEIVER  ARE  INPUT,  OUTPUT  IS  TABULAR 

IFCTC.AND.RC.AND.OOGO  TO  350 
IFCOOGO  TO  350 
IF< .NOT.<TC,AND,RC))GO  TO  905 
URITEC IOOUT,860)UAVEi 

860  F0RMAT<X,47X, tSHWAVELENGTH  ,F7.2,12H  MICROMETERS) 

URITE< I00UT,862)<TRNC0R< I ), 1-1 ,3) 

WRITE< IOOUT,864)<RECCOR< I ),  1-1 ,3) 

862  F0RMAT<37X,28HTRANSMITTER  COORDINATES  ,3F10.2> 

964  F0RMAT<37X,28HRECEIVER  COORDINATES  ,3F10.2) 

WRITEC lOOUT, 866  ) 

866  F0RMAT<X52X, 4HTIME, 1  OX, 1 3HTRANSM I TTANCE > 

340  CONTINUE 

WRITE< I00UT,868>TIME,TRNL0S 
868  F0RMAT<52X,F8.2, 10X,E10.5) 

ONCE= . TRUE , 

GO  TO  400 

350  WRITE< I00UT,923)TIME 

923  F0RMAT<XX,48X,28HT1ME  AFTER  BLAST  ,F7.2> 

IF<  .NOT.CTC.AND.RC))GO  TO  360 
URITE< IOOUT,808) 

WRITEC IOOUT,860)UAVE1 

WRITE< 100UT,862)<TRNC0R< I ), 1=1,3) 

WRITEC  I00UT,864)':RECC0R<  I  ),  1-1  ,3) 

URITEC IOOUT,870)TRNLOS 

J70  F0RMAT<42X,38HTRANSMITTANCE  ALONG  THE  LINE  OF  SIGHT  , El  0,3) 

360  URITEC IOOUT,808) 

WRITE< I00UT,872) 

872  F0RMAT(57X,28HAER0DYNAMIC  CLOUD  DIMENSIONS) 

WR1TE< lOOUT .808) 

UR  I  TEC I00UT,874 )< OBSCORC I ), 1-1,2) 

874  F0RMAT<41X,28H0BSERVER  COORDINATES  ,2F10.2) 

URITEC I00UT,876)HEIGHT 

)76  FORMATC 39X,26HTHE  HEIGHT  OF  THE  CLOUD  IS, 1  OX . F 1 0 . 2 , 7H  METERS) 
URITEC  I00UT,878)<CNTRDC  10),  10-1 ,2) 

J78  FORMATC 38X,28HTHE  CENTROID  COORDINATES  ARE, 8X, 2F 1 0 . 2 ) 

URITEC IOOUT,880)CENWTH 

180  FORMATC 38X,28HTHE  UIDTH  AT  THE  CENTROID  IS, 8X, Ft  0.2,  7H  METERS) 
URITEC I00UT,882 )SPCHT, SPCUTH 

)82  FORMATC 39X, 12HTHE  UIDTH  AT,F8.2,1tH  METERS  IS  ,5X,F10.2,7H  METERS 
URITEC I00UT,884)NCPTS 

J84  FORMATC 46X, 13, 37H  CONTOUR  POINTS  HAVE  BEEN  DETERMINED  ) 

URITEC lOOUT, 886 )C<CPTS< 10, IPT ), 10-1 ,2), IPT-1 ,NCPTS) 

886  FORMATC<60X,2<F1 0,3,2X))) 

400  CONTINUE 
GO  TO  to 


DRT07600 
DRT076t  0 
DRT  07620 
,DRT07630 
DRT07640 
ORT07650 
DRT07660 
DRT07670 
DRT07630 
DRT07690 
DRT07700 
DRT077I 0 
DRT 07720 
DRT07730 
DRT07740 
DRT07750 
DRT  07760 
DRT07770 
DRT077S0 
DRT07790 
DRT07800 
DRT0781 0 
DRT 07820 
DRT07830 
DRT 07840 
DRT07850 
DRT07860 
DRT07870 
DRT07880 
DRTC7890 
DRT07900 
DRT079tO 
DRT07920 
DRT07930 
DRT07940 
DRT07950 
DRT07960 
DRT07970 
DRT07980 
DRT07990 
DRT  08000 
DRT0801 0 
DRT08020 
DRT08030 
DRT08040 
DRT 08050 
DRT03060 
DRT08070 
DRT08080 
DRT08090 
DRT081 00 
DRT 081 1 0 
DRT 08120 
DRT08130 
DRT08140 
DRTC8150 
DRT0St60 
DRT08170 
ORT0S180 
DRT08190 
DRT08200 
DRT 032 1  0 
DRT08220 
)DRT03230 
DRT08240 
DRT08250 
DRT08260 
DRT08270 
DRT0d2e0 
DRT08290 
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4tO  URITE< lOOUT, 088 )  DRTu8300 

888  FORMAT?  ,^38X,48H**  THE  CLOUD  HAS  BEEH  PRECOMPUTED  AND  STORED  ON,  DRT08310 
1  5H  FILE)  DRT08320 

GO  TO  1  0  DRT08330 

900  URITE< IOOUT,901 )  DRT08340 

901  FORMAT? /',24X,48Ht-*-*  DIRTRAN  ERROR  -  MORE  THAN  15  RECORDS  OF  DATA,  DRT08350 

1  35H  HAVE  BEEN  INPUT  WITHOUT  A  GO  CARD.)  DRT08360 

IERR=1  DRT08370 

GO  TO  999  DRT08380 

903  WRITE? lOOUT, 904)  DRT08390 

904  FORMAT? X,39X,47H***  DIRTRAN  ERROR  -  TIMES  ARE  NOT  IN  INCREASING,  DRT08400 

+  6H  ORDER)  DRT08410 

IERR=1  DRT08420 

GO  TO  999  DRT 08430 

905  WRITE? lOOUT, 906 >  DRT08440 

906  FORMAT?718X,46H+**  DIRTRAN  ERROR  -NO  TRANSMITTER  AND  RECEIVER,  DRT08450 

+  49H  AND, ■’OR  OBSERVER  COORDINATES  HAVE  BEEN  SPECIFIED.)  DRT08460 

1ERR=*1  DRT08470 

bO  TO  999  DRT0S4S0 

909  WRITE? lOOUT, 91 0)  DRT08490 

910  FORMAT? X,25X,44H*f*  DIRTRAN  ERROR  -  ONLY  ONE  DATA  RECORD  FOR,  DRT08500 

1  38H  CHARGE  INFORMATION  HAS  BEEN  SPECIFIED)  DRT08510 

IERR=t  DRT0S520 

GO  TO  999  DRT08530 

91 1  WRITE? lOOUT, 912)  DRT08540 

912  FORMAT?/, 16X, 49H***  DIRTRAN  ERROR  -  MINIMUM  AMOUNT  OF  INFORMATION, DRT08550 

1  26H  REQUIRED  IS  NOT  AVAILABLE, /, 1  OX, 1 4H  CHECK  INPUTS)  DRT03560 

IERR=1  DRT08570 

GO  TO  999  DRT0S580 

913  WRITE? lOOUT, 914)  DRT08590 

914  FORMAT? /20X,49H***  DIRTRAN  ERROR  -  BOTH  TRANSMITTER  AND  RECEIVER,  DRT08600 

1  43H  LOCATIONS  MUST  BE  SPECIFIED,  CHECK  INPUTS)  DRT08610 

DRT08620 

GO  TO  999  DRT08630 

915  WRITE? lOOUT, 916)  DRT08640 

916  FORMAT? /30X,50H  lOPT  AND  NARY  DO  NOT  AGREE  SEE  THE  ABOVE  COMMENTS, DRT08650 

1  21 H  FOR  CORRECT  MATCHING)  DRT08660 

IERR=1  DRT08670 

999  RETURN  DRT08680 

END  DRT08690 
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SUBROUTINE  AMOUNT< VOLSPH, URKRL, SPHRL ) 

SUBROUTINE  TO  DETERMINE  LORDING  FOR  THE  SPHERE  AND  UIRKE 
IHPUTS 

VOLSPH  -  VOLUME  OF  THE  BUOYRNTLV  RISING  SPHERE 
hLL  OTHER  HEEDED  INFORMATION  13  PASSED  VIA  COMMON  BLOCKS 
OUTPUTS 

UAKAL  -  AMOUNT  OF  INITIAL  LOADING  OF  SPHERE  THAT  HAS  BEEN 
DEPOSIITEO  IN  THE  WAKE 

SPHAL  -  AMOUNT  OF  INITIAL  LOADIINC  OF  SPHERE  THAT  IS  LEFT 
IN  THE  SPHERE 


FUNCTIONS  AND  SUBROUTINES  NEEDED 
NONE 

J||  Jtf «  J>! «  «  4|  4I1|I  4i  %  111  m  Hi  )|(  4(  an  Hull  iimi  Hi  4i  |||  JUifi «  4t  m  4»  4t «  4I  %  m  m  ^  41  >0  %  *  Xt  X(  « ><i  4c  % 

COMMON.-’NTAL/'TNOT,  VOLNOT ,  TNO,  CBLEED 

COMMON, -'BUOYCL/RSPH ,  DELT ,  V2 ,  XCM,  YCM,  ZCM ,  XTOP ,  YTOP ,  SPHNS<  3  ) ,  R 1  ST  I M 
TSPH=TNO+DELT 

STUFF=.CBLEED*<  VOLSPH/’TSPH-VOLNOT/'THOT  > 

UAKAL=AMINI<SPHNS< 1 ), STUFF) 

SPHAL=SPHNS< 1 )-UAKAL 

RETURN 

END 


AM0UU2SD 
AMOU001 0 
AMOU0020 
AMOU0030 
AMOU0o40 
AMOU0050 
AMOUOObO 
AMOU0070 
AMOUOuSO 
AMOU0090 
AMOUOt  00 
AM0U01 1 0 
AMOU0120 
AMOUCII30 
AMOUOl 40 
AMOU0150 
AMOUOl 60 
AMOUOl 70 
AMuUOi SO 
AMOU0190 
AMOU0200 
AMOU021 0 
AMuUO220 
AMOU0230 
AMOu0240 
AMOU026C 
AMOU0270 
AMOU0280 
AM0U0290 
AM0U0300 
AMOU031 0 
AMOU0320 
AMDU0330 
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SUBROUTINE  ATMCAL<  HATH, ZT , THES, ZU, UHE5, PHI , BETh, DHDT , ERR  > 
REPL  M,N,K,KM 
LOGICAL  ERR^DHDT 

DIMENSION  ZTC  2  ), TMES<  2  ) , ZU<  2  >, UMES<  2  >, ZLO(  6  > 

COMMON  /'UINDPRMZ  DX2  0 ,  DYX 0 ,  D2 0 .  UO,  M,  N ,  ZI NV 
COMMON/EKTEMP/ZO^ZL^TO^TCI .TC2,TC3 
COMMON/EKWl ND/ALP , C , PYF , PXF , UHAT , VHAT 
COMMON/STARS/USTAR , TSTAR , ZSTAR 

COMMON  /lOUHIT/lOIN, lOOUT, IPHFUH, LOUNIT , NDIRTU. HCLI MT , KSTOR , 
COMMON  XCONST/'PI,PI2,PIRAD.TWOPI>TORRMB,CDEGK 
DATA  2L0/'-2.5,-4.5,-13.3,  1  00  00  .  ,  55  .  ,  20  .  Z 
DATA  OMEGA. K  />?  .  2722E~  OS  j  .  4/ 

141 4t  ^  )|t  %  111  ]4t  ^  %  %  4i « i|ii4i]4i  ^  %i4t  .fi « )(t  4ii|i  4t  ifii^  4t  %  i|c  lit  4r  4c 41 4i  94i]^  >41 %  III  %  jfifi  %  i4i  41  %  I4i  9«i 


hTMCuuI 0 
ATMC0020 
ATMCCI03  0 
ATMC0n40 
ATMCOOSC 
ATMCCOe.O 
ATMC0070 
ATMC0080 
NPLOTUATMC0090 
ATMC01 00 
ATMCOt ! 0 
ATMCO)20 
ATMC01 30 
ATMC  0 1 4  0 
ATnCO 


PURPOSE 

TO  FIT  THE  BEST  POWER-LAW  PROFILES  OF  UIND3PEED  AND 
DIFFUSIVITY  CONSISTENT  WITH  KNOWN  RELATIONS  GOVERNING 
THE  CONSTANT  SHEAR  STRESS  LAYER  TO  GIVEN  MEASUREMENTS 
AT  ONE  OR  TWO  HEIGHTS.  ALSO  TO  CALCULATE  PARAMETERS 
NEEDED  FOR  VERTICAL  VARIATION  IN  WIND  DIRECTION  LAYER, 
FOR  WIND  AND  TEMPERATURE  PROFILES. 


INPUTS 

HATH  INTEGER  WHICH  IS  0  IF  WINDSPEED  AND  TEMPERATURE 

ARE  AVAILABLE  AT  TWO  HEIGHTS  AND  EQUAL  TO  THE 
PASGiUILL  CATEGORY  OTHERWISE. 

ZT  SINGLY  DIMENSIONED  ARRAY  CONTAINING  TWO  HEIGHTS 

<IN  METERS)  AT  WHICH  TEMPERATURES  WILL  BE  GIVEN. 
MUST  BE  IN  ASCENDING  ORDER. 

TMES  SINGLY  DIMENSIONED  ARRAY  CONTAINING  THE  TWO 

TEMPERATURE  MEASUREMENTS  IN  DEGREES  KELVIN 
AT  HEIGHTS  ZT . 

2U  SINGLY  DIMENSIONED  ARRAY  CONTAINING  ONE  OR  TWO 

HEIGHTS  <METERS)  AT  WHICH  WIND  SPEEDS  WILL  BE 
GIVEN.  MUST  BE  IN  ASCENDING  ORDER, 

UME3  SINGLY  DIMENSIONED  ARRAY  CONTAINING  THE  ONE  OR 

TWO  WIND  SPEED  MEASUREMENTS  <M/S)  AT  HEIGHTS  UMES . 


PHI 

BETA 

OHDT 


LATITUDE  OF  DETONATION  SITE. 

ANGLE  OF  WIND  VELOCITY  VECTOR  MEASURED  COUNTER¬ 
CLOCKWISE  FROM  EAST. 


A  LOGICAL  VARIABLE  WHICH  IS  .FALSE,  IF  THE 
INVERSION  LAYER  HEIGHT  IS  RELATIVELY  CONSTANT 
AND  .TRUE.  IF  THE  LAYER  HEIGHT  IS  INCREASING. 


OUTPUTS 

ERR  A  LOGICAL  WHICH  IS  TRUE  IF  AN  ERROR  IS  INCURRED 

DURING  THE  CALCULATION. 

DXZO  THE  RATIO  OF  THE  DIFFUSIVITY  IN  THE  X  DIRECTION 

TO  THE  DIFFUSIVITY  IN  THE  Z  DIRECTION.  RETURNED 
IN  COMMON  /WNOPRM/. 

DYXO  THE  RATIO  OF  THE  DIFFUSIVITY  IN  THE  Y  DIRECTION 

TO  THE  DIFFUSIVITY  IN  THE  X  DIRECTION.  RETURNED 
IN  COMMON  /'UNDPRM/. 


ATMC 0  I  6  0 
ATMC  Cl  i  i'  0 
ATMC 01  SO 
ATMCO 1 9  u 
ATMC 02 00 
ATMC 02  t  0 
ATMC 0220 
ATMC0230 
ATMC 0240 
ATnC02:j0 
ATMC 0260 
ATMCu27  0 
ATMC02S0 
ATMC02SO 
ATMC0300 
ATMC 03) 0 
ATMC  032  0 
ATMC0330 
ATMC  034  0 
ATMC0350 
ATMC  036  0 
ATMC037O 
ATMC0380 
ATMC 0390 
ATMC 04 00 
ATMC04  j  u 
ATMC 04 20 
ATMC 0430 
ATMC0440 
ATMC0450 
ATMC0460 
ATMC 047  0 
ATMC04S0 
ATMC0490 
ATMC 05 00 
ATMC051 0 
ATMC0520 
ATMC 0530 
ATMC 0540 
ATMC0550 
ATMC 0560 
ATMC 0570 
ATMC 0580 
ATMC 0590 
ATMC 06 00 
ATMC 061 0 
ATMC 0620 
ATMC0630 
ATMC0640 
ATMC0650 
ATMC0660 
ATMC0670 
ATMC 0680 
ATMC 0690 
ATMC0700 
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THE  COEFFICIENT  OF  2-*fH  IN  THE  VERTICAL  PROFILE 
OF  VERTICAL  DIFFUSIVITV.  RETURNED  IN  COMMON 
/’UNDPRM/'. 

THE  COEFFICIENT  OF  2i>*H  IN  THE  VERTICAL  PROFILE 
OF  HORIZONTAL  WIND  SPEED.  RETURNED  IN  COMMON 
/WHDPRH/’. 

THE  EXPONENT  OF  2  IN  THE  HORIZONTAL  WIND  SPEED 
PROFILE.  RETURNED  IN  COMMON  /'UNDPRM.^ . 

THE  EXPONENT  OF  2  IN  THE  VERTICAL  DIFFUSIVITV 
PROFILE.  RETURNED  IN  COMMON  /UNDPRM.^ . 

ESTIMATED  INVERSION  HEIGHT.  RETURNED  IN  /UINDPRM/ , 


USTAR 


TSTAR 


2STAR 


VELOCITV  PROFILE  SCALE  RETURNED 
/■STARS/^. 


IN  COMMON 


TEMPERATURE  PROFILE  SCALE. 
/'STARS/^ . 


RETURNED  IN  COMMON 


HEIGHT  AT  WHICH  THE  VERTICAL  VARIATION  IN  WIND  ATMCDS3U 
DIRECTION  PROFILES  FOR  WIND  AND  TEMPERATURE  ATMC0S40 

TAKE  EFFECT.  ATMC0S50 

ATMC0960 

OUTPUT  RETURNED  IN  COMMON  /’EKWIND/  ARE  THE  ATMC097  0 

PARAMETERS  HEEDED  FOR  THE  WIND  PROFILE  ABOVE  ZSTAR ,  ATMC09S0 

ATMC0990 

OUTPUT  RETURNED  IN  COMMON  XEKTEMPX  ARE  THE  ATMC1000 

PARAMETERS  NEEDED  FOR  THE  TEMPERATURE  PROFILES  ABOVEATMC J 0 » 0 


ATMC071 0 
ATMC0720 
ATMC0730 
ATMC0740 
ATMC0750 
ATMC0760 
ATMCD77U 
ATMC0780 
ATMC0790 
ATMC0800 
ATKCOSf  u 
ATMC0820 
ATMC083U 
ATMC0840 
ATMC0S5U 
ATMC0S6.0 
ATMCu870 
ATMCuSSO 
ATMC0S9U 
ATMCOSOO 
ATMC091 u 
ATMC0920 
ATMCD93U 
ATMC0940 
ATMC  0950 
ATMC0960 
ATMC0970 
ATMC0980 
ATMC0990 
ATMC1 000 


ZSTAR. 

CALLED  FROM  DUSTCL 

NEEDED  FUNCTIONS  AND  SUBROUTINES 

TMPCAL  CALCULATES  SCALED  TEMPERATURE  PROFILES 

WNDCAL  CALCULATES  SCALED  WIND  SPEED  PROFILES 

DIFFUS  FUNCTION  TO  CALCULATE  THE  DIFFUSIVITV  AT 
HEIGHT. 


GIVEN 


TEMP  CALCULATES  THE  POTENTIAL  TEMPERATURE  AND  GRADIENT 
AT  A  GIVEN  HEIGHT. 

ill  *|i  ^  ^  4i  III  4i  111  4ii|i  III  4ii((  4*  %  4*  %  4*  ^  ^  4*  %  3|t  %  III  %  % 

ERR*. FALSE. 

DELTH  IS  THE  DIFFERENCE  IN  POTENTIAL  TEMPERATURE  BETWEEN  THE 
TWO  HEIGHTS  WHERE  TEMPERATURE  IS  GIVEN. 

20=0.01 

TO=TMES< I ) 

IF<NATM,EGI.  0>GO  TO  100 

ASSIGN  ATMOSPHERIC  PROFILE  ACCORDING  TO  SPECIFIED  PASQUILL 
CATEGORY 

20  FRICTION  HEIGHT 
2L  M0NIN-06UK0V  LENGTH 
USTAR  THE  FRICTION  VELOCITY 
TSTAR  THE  SCALING  TEMPERATURE 

ZL»ZLO<NATM) 

IF<HATM.GE.5>Z0-1 . E-04*ABS< 2L > 

IF<  NATM .  LE  .  3  >2  0=  1  .  E-  03=ABS<  2L  ) 

NP»IFIX<SIGN< 1 . ,ZL>) 


ATMC1 020 
ATMC 1 030 
ATMC1 040 
ATMC1 050 
ATMC1 060 
ATMC1 070 
ATMC1 080 
ATMC1 090 
ATMCl 1 00 
ATMC1 1 1 0 
ATMCl 120 
ATMCl 130 
ATMCl 140 
ATMCl 150 
ATMCl 160 
hTMCI 170 
ATMCl 180 
ATMCl 190 
ATMC1200 
ATMC121 0 
ATMCl 220 
ATMC 1230 
ATMCl 240 
ATMC1250 
ATMC1260 
ATMC1270 
ATMC1280 
ATMC1290 
ATMC1300 
ATMC131 0 
ATMC 1320 
ATMC1330 
ATMC 1340 
ATMC1350 
ATMC1360 
ATMC 1370 
ATMC1380 
ATMC 1390 
ATMC1400 
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USTAR»UHES<  i  >/'UNOCrtL<20,ZL,2U<  i  )> 

TSTAR=TMES<1  )>»iUSTAR*f2/' 1  .568/2L 
IF<NpTM-4>200.300,Z10 
100  CONTINUE 

USE  ITERATIVE  PROCEDURE  TO  CONVERGE  ON  BEST  ATMOSPHERIC  PROFILE 
TO  MATCH  DATA  AT  TUO  HEIGHTS 

DELTH=TME3<  2  >-TMES<  1  >♦  .  0098>*<  2T<  2  >-2T<  1  >  ) 

NP=SIGN< 1 , ,DELTH) 

DELU=UMES<2)-UMES<  1  ) 

2UL0&=AL0G<  ZU<  2  .VZU<  1  >  > 

ZTL0G»AL0G<  ZT<  2  j/'ZT^  1  >  ) 

USTAR=<UME8<2)-UMES<  1  >>/'2UL0G 

T3TAR=DELTH/‘2TlOG 

2L=  .  638*TMES<  1  >*USTAR**2/'TSTAR 

IF(' A63<  2L  >  .  GE  .  1  000  .  >G0  TO  300 

DO  HO  ITER«=1H00 

USTAR»DELU/'<  WNDCAL<  20,  ZL,  2U<  2  >  )-UNDCAL(  Z 0 ,  ZL ,  2U<  1)  >  > 
TSTAR-0ELTH/<  TMPCAL<  ZO, ZL, ZT<  2  )  >-TMPCAL<  ZO, ZL , ZTC 1  > ) > 

ZLP«ZL 

ZL=  .638*TMES<  1  )*USTAR-*'»2/'TSTAR 
IF<:aBS<:<2L-2LP)/'2LP).LT,  .01  >GO  TO  120 
110  CONTINUE 
ERR= . TRUE . 

GO  TO  998 
120  CONTINUE 

IF<2L.GT.  0,  >20*1  .  E-04>*ABS<  2L  ) 

IF<ZL.LE.0,  )20«1  .E-03'*ABS<2L) 

1F<NP>200,300,21 0 
200  CONTINUE 

unstable  ATMOSPHERE 

DXZ0=2.6 
M-. 079943 
N-4  ./3, 

D20=,7609*USTAR'*ABS<ZL  >♦■*<  1  .-N> 

U0=USTAR* 1 4 . 2478/ABS<  2L  Jf^M 
GO  TO  430 
21 0  CONTINUE 

STABLE  ATMOSPHERE 

DXZ0»3.3 
N=, 45644 
M=,28414 

D20=  .  05951  7fUSTAR*ABS<  ZL  >■*>*<  1  .-N) 

UO-USTARi-SB  .  66427ABS<  ZL  )i''*M 
GO  TO  430 
300  CONTINUE 

NEUTRAL  ATMOSPHERE 

D20=.4*U3TAR 
DXZO.2.8 
NP=0 
N»1  . 

M»1 .77. 

U0=45 . 92*USTAR7ABS<  2L  >'**M 
430  CONTINUE 

COMMON  CALCULATION  TO  UNSTABLE,  NEUTRAL,  AND  STABLE  ATMOSPHERES 
DYX0«1 . 

IF<NATM ,  EQ .  0  >U0»<  U0+UMES<  2  )7ZU<  2  >>*-*M  V2  . 

ESTIMATE  THE  INVERSION  HEIGHT  AND  COMPUTE  THE  NECESSARY 
PARAMETERS  FOR  THE  WIND  AND  TEMPERATURE  PROFILES  BETWEEN 
2STAR  AND  ZINV  WHEN  DHDT  IS  .PALSE. . 


ATMCMl  0 
ATMC1420 
ATMC 1 430 
ATMC1440 
ATMC 1450 
ATMC1460 
ATMC1470 
ATMC1480 
ATMCl 490 
ATMC 1500 
ATMC151 0 
ATMC 1520 
ATMCl 530 
ATMC 1540 
ATMC1550 
ATMC1560 
ATMC1570 
ATMC 1580 
ATMC1590 
ATMC1600 
ATMC161 0 
ATMC1620 
ATMCl 630 
ATMC1640 
ATMCl 650 
ATMC1660 
ATMC1670 
ATMC 1680 
ATMCl 690 
ATMC1700 
ATMC171 0 
ATMC 1720 
ATMC1730 
ATMC1740 
ATMC 1750 
ATMC1760 
ATMC1770 
ATMC1780 
ATMCl 790 
ATMCl 800 
ATMC1810 
ATMC1820 
ATMC1830 
ATMCl 840 
ATMC1850 
ATMC1860 
ATMC1870 
ATMCl 880 
ATMC1890 
ATMC1900 
ATMCl 91 0 
ATMC 1920 
ATMC1930 
ATMC 1940 
ATMCl 950 
ATMC1960 
ATMCl 970 
ATMC19S0 
ATMC 1990 
ATMC2000 
ATMC201 0 
ATMC2020 
ATMC2030 
ATMC2040 
ATMC2050 
ATMC2060 
ATMC2070 
ATMC2080 
ATMC2090 
ATMC2I 00 
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APHI-PHI^PIRAD 
FREQ=2.fOMEGP*SlH< PPHI ) 
HC=K*USTAft/^FREQ 

IF<ZL.GT.0.0.hHD,ZL.LT.1 .E3>G0  TO  500 

2INV=HC 

GO  TO  501 

500  2INV=.26*HC 

501  ZSThR-.  131-ZINV 
KM-DIFFUS<20iZL,2STAR> 
SP*USTAR>»«NDCAL<  ZO ,  ZL  ,  ZSTAR  > 

AUP-SQRT<  FREQ/’<  2  .  t-KM  )  ) 

IF<DHDT)GO  TO  813 
ARG=ALP*2STAR 

ARG1  =BETA+hLP'*ZINV 
ARG2=ALP-*><  ZINV-ZSTAR  > 

C=SP*EXP<  ARG>*SIN<  ARG1  )/‘SIN<ARG2  ) 
PYF=C*EXP<  -ARG  >fCOS<  ARG  >-SP>t.COS<  BETA  > 
PXF=C>«*EXP<  -ARG  >*SIN<  ARG  >+SP‘t‘3IN<  BETA  > 
UE=C*EXP< -ARG  >*COS<  ARG  >-PVF 
VE=-C*EXP< -ARG  )*SIH<  ARG )+PXF 
UHAT=UE/3QRT<  UE*UE+VE*VE i 
VHAT=vE/'3QRT<  UE>fUE+VE>t«VE  'J 
CALL  TEMP<ZSTAP,TA,DTA£>Z> 

DTADH=0. 0 

TC3=<  DTADH-DTADZ  V<  2 . *<  ZINV-ZSTAR ) > 
TC2=DTAD2-2 . *TC3*2STAR 
TC1=TA-TC2*ZSTAR-TC3*ZSTARKf2 
GO  TO  999 
813  ZSTAR=1 .E4 
999  RETURN 
END 


ATMC21 1 0 
ATMC2120 
ATHC21 30 
ATHC21 40 
ATMC21 50 
ATI1C2160 
ATMC21 70 
ATMC21S0 
ATnC2190 
ATNC2200 
ATMC221 0 
ATI1C2220 
ATMC2230 
ATMC2240 
ATHC22S0 
ATMC2260 
ATMC2270 
ATMC.2280 
ATMC2290 
ATMC2300 
ATMC231 0 
ATMC2320 
ATp1C2330 
ATMC2340 
ATMC2350 
ATMC2360 
ATHC2370 
ATMC2380 
ATrlC2390 
ATHC2400 
ATMC24I 0 
ATMC2420 
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SUBROUT  I HE  AVRG<  ZX, TIME , QTOT, XB^VG, SIG2X, SIGZV  > 
ROUTINE  FOR  FINDING  NVERflGES  OF  THE  MOMENTS  OF  THE  DISCS 


INPUTS 


-  HEIGHT  AT  WHICH  THE  AVERAGES  ARE  DESIRED 


TIME  -  PRESENT  TIME 
QTOT  -  SUM  OF  TOO+QDSCS 

XBAVG-  AVERAGE  OF  THE  FIRST  ORDER  MOMENTS  <ALONGWIND  DISPLACEMENT 
IN  THE  WIND  DlKfcCTION> 

3IG2X-  AVERAGE  OF  THE  SQUARE  OF  ONE  OF  THE  SECOND  ORDER  MOMENTS 
<ALONGWIND  SPREAD > 

SIG2Y-  AVERAGE  OF  THE  SQUARE  OF  ANOTHER  SECOND  ORDER  MOMENT 
<CR0S3ulIHD  SPREAD) 

itiix  «««*«  i*  4I « >t>  1*  «>)•  I*  >«<  I*  4<<«  >l>  «»■<*:*<*<•»*<  IK  >«<«  <*><•*  <«•«  Ik  W  **  Ik  ««« 1*1  <1  Sti  Hi «« 1*  « >ti  W  1«| «««  W 

COMMON, '“D I SCS/'HDSCS  .  TDSC<  2  0  >,  XDSC<  20  >,  2DSC<  20  >,  R.2DSC<:  2  0  >,  QDSC<  20 , 3 

COMMON.-’PRTINFXRO,  VGRAV<3),NPRTS 

QTOT=0 , 0 

G3IG2X=0. 0 

QSIG2V=0. 0 

QXBAR=0 . 0 

2=2X 

DO  10  I=1.NDSCS 
H=ZDSC< I  ) 

ROH2=R2DSC< I ) 

TOF*TIME-TDSC< I ) 

CALL  M0MENT<  VGRAV<  t  > ,  2,  H,  TOF,  Q,  XBAR ,  SIGu(2,  S IGP2  > 

QT«ODSC<  I,  1  Ji^Q 
QTOT=»QTOT+QT 

QSIG2X-QSIG2X+<SIGW2+R0H2,^2.  )*QT 
QSIG2V=QSlG2y+<  SIGP2+R0H2X2 .  )ikQT 
QXBAR»QXBAR+<  XBAR+XDSC<  I  )  >ikQT 
to  CONTINUE 

XBAVG-QXBARXQTOT 
SIG2X=QSIG2X/'QT0T 
SIG2y-QSIG2YXQT0T 
999  RETURN 
END 


AVRG0230 
AVRGOOl 0 
AVRG002U 
AVRG0030 
AVRG0040 
AVRG0050 
AVRG0060 
AVRG0070 
AVRG0090 
AVRG0090 
AVRGOt  00 
AVRG01 1 0 
AVRGOI 20 
AVRG01 30 
AVRGO j  40 
AVRGOI 50 
AVRGOI 60 
AVRGOI 70 
AVRGOI SO 
AVRG0t90 
AVRG0200 
AVRG021 0 
AVRG0220 
:>AVRG024  0 
AVRG0250 
AVRG0260 
AVRG02^0 
AVRG02S0 
AVRG0290 
AVRG0300 
AVRG03t  0 
AVRG0320 
AVRG0330 
AVRG0340 
AVRG0350 
AVRG0360 
AVRG0370 
AVRG0380 
AVRG0390 
AVRG0400 
AVRG041 0 
AVRG0420 
AVRG0430 
AVRG0440 
AVRG0450 
AVRG0460 
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SUBROUTINE  CLIMB< FUNCT, GEUN, P 1 ,FP1 , NSERCH, NOCONT > 

THIS  module  is  a  SUBROUTINE  THAT  FINOS  A  POINT  ON  P  CONTOUR 
BY  FINDING  THE  GRHDIEHT  VECTOR  AT  THAT  POINT  AND  MARCHING  ALONG 
IT  UNTIL  IT  FINDS  ITSELF  IN  A  REGION  GREATER  THAN  THE  CONTOUR  LEVEL, 
AT  WHICH  POINT  IT  MARCHES  HORIZONTALLY,  HALVING  THE  STEP  SIZE 
UNTIL  THE  CONTOUR  IS  REACHED  WITHIN  SPECIFIED  RESOLUTION. 

IN  ADDITION  IT  WILL  DETERMINE  IF  A  CONTOUR  EXISTS. 

ARGUMENTS  PASSED. 

INPUT 

FUNCT-THE  FUNCTION< X, Y )  ALSO  GIVEN  IN  EXTERNAL. 

PI -THE  STARTING  POINT. 

OUTPUT 

PI  -  THE  POINT  ON  THE  CONTOUR  OR  THE  POINT  AT  WHICH 
THE  FUNCTION  REACHES  A  MAXIMUM  BELOW  THE  CONTOUR 
LEVEL 

FPi  -  THE  VALUE  OF  THE  FUNCTION  AT  P 
NOCONT-THE  ERROR  FLAG. 

F-NO  PROBLEM 
T-NO  CONTOUR  FOUND, 

ERR-ERROR  FLAG  RETURNED  BY  NTRSCT 
F-NO  ERROR 

T-ITERATION  DIVERGED  OR  MAXIMUM  SEARCH  AREA  EXCEDED 
IN  ADDITION, IN  COMMON  ARE.., 

YMIH-THE  LOWER  LIMIT  ON  Y. 

DELTA-  THE  STEP  SIZE, MODIFIED  IN  THIS  SUBROUTINE. 

CON-THE  CONTOUR  LEVEL. 

RES-THE  RESOLUTION  LENGTH 

OTHER  VARIABLES  INCLUDE 

GRAD-THE  GRADIENT  VECTOR 
PO-THE  CURRENT  POINT  ON  THE  GRADIENT. 

PI -THE  POINT  ON  THE  GRADIENT  BEING  TESTED 
TO  SEE  ABOUT  CONTOUR  EXISTENCE. 

FP0,FP1-THE  FUNCTION  VALUES  OF  PO  AND  PI. 

CALLED  SUBROUTINES 

GRAD2-FIN0S  THE  GRADIENT  VECTOR  OF  A  FUNCTION  AT 
A  POINT  AND  THE  SLOPE  THERE, 

UNIT-CALCULATES  THE  NORM  AND  MAGNITUDE  OF  A  2  VECTOR. 
VSUM-VECTOR  SUM  OF  THE  FORM  C-A+SB  WHERE  S  IS  SCALAR 
MULTIPLIER  OF  B. 

EXTERNAL  FUNCT 
LOGICAL  NOCONT 

DIMENSION  GRAD<2),P0<2),P1<2> 

COMMONXL  INE/'BASE<  2  ) ,  D I R<  2  ) ,  DFDS/SPECSXRES ,  DELTA ,  THET AN ,  CON 

COMMONXLIMITXYMIN,FMIN 

NOCONT®, FALSE . 

0NEM=-1 . 0 

IF  <NSERCH.EQ. 0)GO  TO  7 
DELTA-SIGN< DELTA, FLOAT<NSERCH)) 

FP1=FUNCT<P1< 1  ),P1<2)) 

1F<FP1 .LT.CON>GO  TO  25 
GO  TO  22 

3  CONTINUE 
P0<  1  )-P1<  1  > 

P0<2)=P1<2) 

FP0®FP1 

C  FINDING  THE  UNIT  GRADIENT  AND  THE  NEXT  POINT  ALONG  IT. 

4  CALL  GRAD2<P0, FUNCT, RES, GRAD, DFDS> 


CLI00520 
CL10001 0 
CLI 00020 
CL  I  0  003  0 
CLI 00040 
CLI00050 
CLI OOOSO 
CLI 00070 
CLI OOOSO 
CLI  OOOSO 
CLI OOi 00 
CLI001 1 0 
CL100120 
CLI00130 
CLI00140 
CLI 001 50 
CLI  00160 
CLI00170 
CLI 001  BO 
CLI 00 190 
CLI 00200 
CLI0021 0 
CLI 00220 
CLI 00230 
CLI 00240 
CLI 00250 
CLI  00260 
CLI00270 
CLI 00280 
CLI 00290 
CLI 00300 
CLI0031 0 
CLI 00320 
CLI00330 
CLI00340 
CLI00350 
CLI00360 
CLI00370 
CL  I  00380 
CLI 00390 
CLI 00400 
CLI 0041 0 
CLI00420 
CLI 00430 
CLI 00440 
CLIO 0450 
CLI 00460 
CLI00470 
CLI00480 
CL100490 
CLI00500 
CLI0051 0 
CLI00530 
CLI00540 
CLI00550 
CLI00560 
CLI00570 
CLI00580 
CLI00590 
CLI00600 
CLI 0061 0 
CL100620 
CLI 00630 
CLI00640 
CLI00650 
CLI00660 
CL100670 
CLI00680 
CLI00690 
CLI00700 


t 


5  ChLL  VSUM<i  PO,  GR^&,  delta,  pi  > 

♦  *  IS  THE  POINT  HEADING  BELOW  YMIN 
IF<P1<2>.GE.YMIN>G0  TO  7 
PU2  ;=YMIN 

CALL  VSUM<P1 ,PO,ONEM,GRAD> 

CALL  UNIT<GRAD, GRAD, DELTA) 
IF<ABS< DELTA  ),LT. RES )GO  TO  25 

7  FP1=FUNCT<P1< 1 ),Pt<2>) 

**  HAS  THE  CONTOUR  BEEN  CROSSED 

8  1F<FP1  .GE.CON>GO  TO  22 
IFcFPi  .GT.FPOGO  TO  3 
DELTA=DELTA72. 

IF< ABS< DELTA >. LT . RES >GO  TO  23 
GO  TO  5 

25  NOCONT=.TRUE. 

GO  TO  99 

22  continue 

BEGIN  HORIZONTAL  SEARCH 
P0<  2  >=P1  <  2  } 

31  P0< 1 j=P1< 1 > 

FP0=hP1 

40  P1< 1  )=P0< 1  )+DELTA 

FP1=FUNCT(  PK  1  >,P1<2  )) 

IF< ABS< DELTA ). LT. RES72, JGO  TO  99 
iKlFPi  .GE  .CON  >GO  TO  31 
DELTA=DELTA/2. 

GO  TO  40 
99  CONTINUE 
RETURN 
END 


CLI 0071 0 
CLI00720 
CLI 00730 
CLI00740 
CLI00750 
CLI 00760 
CLI00770 
CLI  00780 
CLI00790 
CLI 00800 
CLI 0081 0 
CLI 00820 
CLI 00830 
CLI  00840 
CLI 00850 
CLI 00860 
CLI  008 .'0 
CLI  00880 
CLI 00890 
CLI 00900 
CLI 0091 0 
CLI00920 
CLI 00930 
CLI 00940 
CLI 00950 
CLI 00960 
CLI 00970 
CLI 00980 
CLI 00990 
CLI01 000 
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SUBROUTINE  CLDIMC CNTRD , HE IGHT , CENUTH. SPCHT , SPCUTH, NCPTS, CPTS5, 

1  ERR  > 

«  «  DC  He «  Hi «  *  «  *  4i  Di « itc «  Di  I*  «  *  «  *  *  *  lii  41  >)»ll  »■  *  *  *  *  *  <tl  >•■ « ’•»*  *  <<>  Ik  «  »  «  *  *  4! «  I*  *  »  «  »  «  «  « :4ii«i  :|i 

PURPOSE 


CLD0001 0 
CLD00020 
CLD00030 
CLD00040 
CLD0005C 
CL000060 
CL000070 
CLOOGOBO 
CLD00090 


CLDIM  CALCULATES  FIVE  CONTOUR  POINTS  AND  CLOUD  DIMENSIONS  AS 

SEEN  FROM  THE  SPECIFIED  OBSERVER  POSITION.  CLDIM  REQUIRES  CLOUD  _ 

PARAMETERS  FROM  THE  BUOYANT  RISE  STAGE  OF  CLOUD  DEVELOPMENT  WHICH  CLDOOlOO 
ARE  SUPPLIED  IN  COMMON  STORAGE  /BUOYCL/  AND  /'PRTINF/'  AS  WELL  AS  CLD00110 
VIEWING  GEOMETRY  WHICH  IS  SUPPLIED  IN  COMMON  /GEOM/ .  SPCHT  IS 
REQUIRED  INPUT  IN  THE  ARGUMENTS.  ALL  OUTPUTS  ARE  ARGUMENTS. 


THE  SPECIFIED  HEIGHT  AT  WHICH  THE  WIDTH  OF  THE  CLOUD 
IS  DESIRED.  < METERS; 


CLIMB 


CALLED  BY  DUSTCL 


CLD001 20 
CLD00t3O 
CLD00140 
CLD001 50 
CLD00160 
CLDuul  r(i 
CLDOOIBO 
CLD0019U 
CLD00200 
CLD0021 0 
CLO 00220 
CLD00230 
CLD00240 

A  SINGLY  DIMENSIONED  ARRAY  OF  LENGTH  2  WHICH  CONTAINS  CLDo0250 
THE  HORIZONTAL  AND  VERTICAL  COORDINATES,  RESP.,  OF  THE  CLD00260 
CLOUD  CENTROID.  < METERS)  CLD00270 
THE  HEIGHT  OF  THE  CLOUD  IN  METERS  CLD00280 
THE  WIDTH  OF  THE  CLOUD  AT  THE  CENTROID  HEIGHT  IN  METERS  CLD00290 
THE  WIDTH  OF  THE  CLOUD  AT  THE  SPECIFIED  HEIGHT  < METERS)  CLD00300 
THE  NUMBER  OF  CONTOUR  POINTS  < =6 >  CLD00310 
A  DOUBLY  DIMENSIONED  ARRAY  OF  SIZE  < 2 , N >, N . GE . 5,  WHICH  CLD00320 
CONTAINS  THE  HORIZONTAL  AND  VERTICAL  COORDINATES  OF  CLD00330 
THE  FIVE  CONTOUR  POINTS.  <METERS)  CLD00340 

CLD00350 
CLD00360 
CLD00370 
CLDa0380 
CLD00390 

IF  SO  FINDS  A  POINT  CLD00400 

CLD0041 0 
CLD00420 
CLD00430 
CLD00440 
CLD0045G 
CLD00460 
CLD00470 
CLD00480 
CLD00490 
CLP00500 
CLDOOSt  0 
CLD00520 
CLD00530 
CLD00540 
CLD00550 
CLD00560 
CLD00570 


INPUT 

SPCHT 


OUTPUT 

CNTRD 


HEIGHT 

CENWTH 

SPCWTH 

NCPTS 

CPTS 


REQUIRED  SUBROUTINES 


DETERMINES  IF  THE  CONTOUR  EXISTS, 
OH  THE  CONTOUR. 


DIMENSION  CNTRD<  2  ) , CPTS5<  2,6), TOP<  2 ) 

LOG  I  CAL  HOR I Z , NOCONT , SWITCH , CHANGE, ERR 
REAL  KZ  KX 

COMMON  >BU0YCL7RSPH,DELT, VZ,XCM, YCM,ZCM,XTOP, YTOP,SPHNS<  3),TIM 
COMMON  /PRT1NF7R0,VGRAV<3),HPRTS 

COMMON  /GE0M/C0STH2,SINTH,SINTH2,VISEXT,RTPI,SCRN<2 ) 

COMMON  7M0DE/  HORIZ 
COMMON  /"CLOCK/  T.TWIND 

COMMON  /ARRAY/OVRLAP , AREA , PER  I M , PR GARY , CEHD IF 
COMMON/WNDPRM/DXZO , DYX 0 , OZ 0 , U 0 , UM , DN,  Z INV 

C0MM0N/TRAN/VTR,K2,KX, TTR, XTR, ZTR, QPUFF<  3 ), SWITCH, CHANGE 

COMMON/SIG/SIG02,SIGC  wL.t'uus,.  v 

COMMON  /lOUNlT/IOlN, lOOUT , IPHFUN , LOUNIT, NDIRTU , NCLl MT, KSTOR , NPLOTUCLD00380 
COMMON/DISCS/NDSCS,TDSC<20),XDSC<20),ZDSC<20>,R2DSC<20),  CLD 00590 

1  QDSC<20,3)  CLD00600 

COMMON  /SPECS/  RES, STEP, TANT, CON  CLD00610 

COMMON  /C0NST/PI,PI2,P1RAD,TW0PI,T0RRMB,CDECK  CLD00620 

EXTERNAL  FUNCT,GFUN  CLD00630 

DATA  RES, TANT  /.4, ,1/  CLD00640 

HORIZ-.TRUE,  CLD00650 

ERR*. FALSE.  CLD00660 

CON=ALOG<VISEXT)  CLD00670 

CPTS5<2, I )-SPCHT  CLD00680 

CPTS5<2,6)-SPCHT  CLD00690 

U»U04.CPT85<2,  1  )>k*UM  CLD00700 
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CPTS5< 1 , 1  )=T*U*SINTH 
CPTS5< 1 ,6>=CPTS5<  i  ,  1  ) 

N3ERCH=-1 

STEP=20. 

CALL  CLIMB  TO  SEARCH  FOR  THE  EDGE  OF  THE  CLOUD  IN  ONE  DIRECTION  AT 
THE  HEIGHT  OF  THE  OBSERVER, 

CALL  CLIMB<FUNCT,GFUN,CPTS5.FP1 , NSERCH, NOCONT ) 

NSERCH=1 

STEP=20. 

CALL  CLIMB  TO  SEARCH  FOR  THE  EDGE  OF  THE  CLOUD  IN  THE  OPPOSITE 
DIRECTION  AT  THE  HEIGHT  OF  THE  OBSERVER. 

CALL  CLIMB<FUHCT,GFUN,CPTS5< 1 , 6 >, FPl , NSERCH , NOCONT ) 
SPCUITH=CPTS5<  1 , 6  )-CPTS5<  1,1) 

NC.PTS=6 

IF<T.LE.TU1ND)G0  TO  50 

CNTRD< 1  )«<XTR+VTR*<T-TTR)>*SINTH+CENDIF 
CNTRD<2>=ZTR 

SIGX2-S1G02+2 , •KX-K  T-TTR  > 

SI G22=3I G02+2 . T-TTR  > 

SIGX=SQRT<  SIGX2 ) 

SIGZ=3CikT<  SiG22  > 

BOT=1  .X<2.*VISEXTi 
ARG=BuT*QPUFF(  1  )/'PI/'SIGX/’SIGZ 
IF<ARG.LT. 1 . 0>GO  TO  998 
TuP< 1  )=CNTRD< 1  > 

TOP<  2  )*2TR+S  ICZ*8aRT<  2  .  ■*.ALOG<  ARG  >  > 

RAD=SI GXfSORT<  2 . *ALOG<  ARG ) ) 

CENWTH-2 . *<  RAD+PR VARY ) 

HEIGHT-T0P<2> 

GO  TO  100 

50  CNTRD<  1  )*=XCM*SCRN<  1  >+YCMt-SCRN<  2  )+CENDIF 
CNTRD<2)=2CM 

TOP<  1  )=XTOPh.SCRN<  1  )+YT0P*SCRN<2>+CENDIF 

T0P<2)=ZCM+RSPH 

IF<  TOP<  2 ) . GT . ZINV )TOP<  2  >=ZINV 

HEIGHT=T0P<2) 

CENUTH-2 . ♦<  RSPH+PR VARY  > 

1 00  CPTS5< 1 , 2  )=CNTRD< 1 )-CENWTHX2 . 

CPTS5<2,2)=CNTRD<2> 

CPTS5< 1 , 3 )-TOP< 1  )-PR  JARY 
CPTS5<2,3>»T0P<2) 

CPTS5< 1 , 4 )=TOP< 1  )+PR  JARY 
CPTS5<2,4>=T0P<2) 

CPTS5<  1 , 5  )=CNTRO<  1  )+CENWTH/'2  . 

CPTS5<2,5)=CNTRD<2> 

NCPTS=6 
GO  TO  999 

998  WRITE< lOOUT, 1000) 

1000  FORMAT<50H  UPPER  PART  OF  CLOUD  HAS  DISSIPATED  > 

999  RETURN 
END 


CLD0071 0 
CLD00720 
CLD00730 
CLD00740 
CLD00750 
CLD00760 
CLD00770 
CLD00780 
CLD 00790 
CLD00800 
CLD00S1 0 
CLD00820 
CLD00830 
CLD00S40 
CLD00650 
CLD 00860 
CLD00870 
CLD00880 
CLD 00890 
CLD 009 00 
CLD0091 0 
CLD00920 
CLD00930 
CLD00940 
CLD00950 
CLD00960 
CLD00970 
CLD00980 
CLD00990 
CLDOl 000 
CLDOl 01 0 
CLDOl 020 
CLDOl 030 
CLDOl 040 
CLDOl 050 
CLDOl 060 
CLDOl 070 
CLDOl 030 
CLDOl 090 
CLDOl 1 00 
CLDOl 1 1 0 
CLDOl 120 
CLDOl 130 
CLDOl 140 
CLDOl 150 
CLDOl 160 
CLDOl 170 
CLDOl 180 
CLD0n90 
CLD01200 
CLD0121 0 
CLD01220 
CLD01230 
CLD01240 
CLDOl 250 
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SUBROUTINE  COMPCL<  NEWATH, HATMOS, 2TEMP, THPHES, ZUNO, UNDHES, THWND, 

1  PHI .HEWSRC,CHWT,NCHRC^NCHS,DETDEP,NSOIL,DSOD, 

2  NUL, TRNCOR.RECCOR, TIME, OHDT,TRNLOS, HERR > 


COMOOtSO 

COM00170 

conooiso 

COM0001 0 
COM00020 
COM00030 


CONTftOLINC  ROUTINE  FOR  PRECOMPUTING  A  SINGLE  ,  EXPLOSION  PRODUCED 

OUST  CLOUD  AND  STORING  IT  OH  AN  EXTERNAL  FILE  TO  BE  USED  AT  A  . . . 

LATER  RUNNING  OF  THE  CODE  FOR  A  RANDOM  DISTRIBUTION  IN  SPACE  AND  T1MECOM0004U 
OF  CHARGES  COM00050 

COMOOOSO 

INPUTS  COM00070 

FOR  DETAILS  SEE  DRTRAN  COM00030 

COM00090 
COMOoI 00 

OUTPUTS  COMOOI  10 

COMOOI 20 

TRNLOS  -CALCULATE  TRANSMITTANCE  ALONG  THE  SPECIFIED  LINE  OF  SIGHT  COM00130 

COMOOI 40 

Ik 41  Hof  %X<«X<i|c>|i  *  in  If  ’•ol'O'K Don *»<>«<  Hof  >**■*< Ik* 41  «K<K<  XI  If  X< »<*>•■  Hi  ««  COM  0  0  1  5  0 

DIMENSION  ZTEMPC  2 i, TMPMES<  2  >, 2UND<  2 ),yNDMES<  2  >, TRNCORc  3  >,  COMOOI 90 

1RECCCIR<3),TRNFRM<2,2),SIDE1<2>,SIDE2<2>,NCHS<2>,0RIG<2>,TRN<3),  COMO  02  00 

2  REC<3),SRCBAS<2),PAS<6>  COM0021  0 

LOGICAL  DHDT,NEWATM,HEUISRC, ERR, FLAG  COM00220 

C0MM0N/GE0M/C0STH2, SI  NTH, S 1NTH2 , VI SEXT, RTPI , SCRN<  2  )  COM0023  0 

COMMON  XIOUHITXIOIN, lOOUT, IPHFUN , LOOHIT , HDIRTU, NCLIMT , KSTOR , NPLOTUCOMO 024 0 
COMMON/VLXVLOAD  COM00250 

COMMON/OPTIONXIOPT, IFILE  COM00260 

COMMON/CLOCKXFTlME,TUlND  COM00270 

COMMON/BUOYCL/'Y<  8  ),  SPHHS<  3  >,RT1M  COMO 0280 

COMMON/’DISCSXNOSCS,TDSC<20),XDSC<2  0>,ZDSC<2  0>,R2DSC(2  0>,ODSC(20,3>COM0  0290 
- - COM00300 


C0KM0N/M05/0IFF<  2,200 ),NCHTOT.PRSEP< 200), NTOT, NARY, ITOT, 

+  COOR<2,200>,TSTAG<200), 

+  1COUNT,TIMES<25),XCO<3,2S),XC1<3,25>,RT<3,25), 

1  RB<3,25),22<3,25> 

COMMON/i'WNDPRM/OXZO,  OY20 , 020 ,  UO,  UM,  ON,  ZINV 
COMMONXCARB/RCARB1 ,RCARB2 

COMMON  XCONSTXPI , PI2, PIRAD, TWOPI , TORRMB, CDEGK 
DATA  FLAG/. TRUE./ 

DATA  PAS/4HA  , 4H8  ,4HC  ,4HD  ,4HE  ,4HF  / 

IF< I0PT.EQ.4)G0  TO  500 

PRECOMPUTE  INFORMATION  AND  STORE  ON  FORTRAN  UNIT  IFILE 

THETAX=THUNDxiPI/ 1  8  0  , 

TWIND-1 ,E5 
TTR=1 ,E5 

IF<  ,NOT,NEHATM>GO  TO  10 

CALL  ATMCAL<  NATMOS , ZTEMP , TMPMES , ZWND , WNDMES, PHI , THETAX , DHDT , ERR  > 
IF< ,NOT,ERR)GO  TO  10 
NERR=7 
GO  TO  999 
10  CONTINUE 

IF<  .NOT.NEWSROGO  TO  20 

CALL  SOURCE< CHWT , NCHRG, DETOEP , NSOIL , OSOD > 

20  CONTINUE 

COMPUTE  INITIAL  LOADING 
SUM*0. 0 

DO  25  I«1,HDSCS 
SUM=SUM+QDSC< 1,1) 

25  CONTINUE 

VLOAD*SPHNS< 1 )+SUM 


CALL  PRECL  TO 
FOR  THE  CONE 


COMPUTE  AND  STORE  THE  QUADRATIC  FITS  NECESSARY 


500 


CALL  PRECL< NATMOS, ZTEMP, THPMES, ZWND, WNDMES, THWND, PHI , DHDT, 
1  CHWT , NCHRG , DETDEP , NSO 1 L , DSOD , S I LT ) 

GO  TO  999 
CONTINUE 


COM0031 0 

COM00320 

COM00330 

COM00340 

COM00350 

COM003S0 

COM00370 

COM00380 

COM00390 

COM00400 

COM 0041 0 

COM00420 

COM00430 

COM 00440 

COM00450 

COM004S0 

COM00470 

COM00480 

COM00490 

COM00500 

COM0051 0 

COM 00520 

COM 00530 

COM00540 

COM00550 

COM00560 

COM00570 

COM 00580 

COM00590 

COM00600 

COMOOet  0 

COM00620 

COM00630 

COMO 064 f 

COM 0065 

COM 00660 

COM00670 

COM00680 

C^M00690 


140 


ooooo  ooo  ooo  oori 


M 


IF< . NOT . FLAG >  GO  TO  35 

READ< IFILE  ;HATM0S , ZTEMP< 1  ),TMPHES< 1 >,ZUND< 1 >,WNDMES< 1  > 

READ< IFILE  JDHDT, PHI , CHUT , NCHRG , DETOEP , NSOIL . DSOD, SILT, ZIWV 
READ< IFILE )VLOAD,RCARB1 .RCARB2 
READ< IFILE )ICOUNT 
DO  30  J=l,ICOUNT 

READ( IFILE )  TIMES<  J  )  , < RT< I , J ) , RB< I , J > , 22< I , J > , XC 0(  I ,  J ) , 

1  XCK  I,  J),  1  =  1 ,3> 

30  CONTINUE 

URITE< IOOUT,800) 

800  F0Rt1AT</’,5X,85H  ATMOSPHERIC,  CHARGE,  AND  SOIL  CHARACTERISTICS 
1  WHEN  THE  CLOUD  WAS  PRECOMPUTED.  > 

WRITE  OUT  ATMOSPHERIC  INFORMATION 

URITE< IOOUT,80a> 

308  FORMAT<iX> 

WRITE< lOOUT, 8( 0 )PAS<  NATMOS ) 

810  FORMAT<30H  PASOUILL  CATEGORY  ,  A4 > 

NIO=1 

WRITER  I00UT,812  )<2TEMP<  I  ),TMPME3<  I  >,Ziji)ND<  I  >,WNDMES<  O,  1  =  1  ,NIO: 


812  F0RMAT<8H  HT  ,F8.2,7H  TEMP  ,F8.2,7H  HT,F8 

1  F8.2> 

WRITE< I00UT,814)THWND 

814  F0RMAT(22H  WIND  DIRECTION  ,F8.2> 

WRITE< I00UT,819)PHI 
IF<DHDT  )WRITE< I00UT,816) 

816  FORMAT<40H  THE  INVERSION  LAYER  HEIGHT  IS  GROWING 
IF< .NOT.DHDT3URiTE< I00UT,818> 

818  F0RMAT<42H  THE  INVERSION  LAYER  HEIGHT  IS  CONSTANT 
818  F0RMAT<,^22H  LATITUDE  ,FS.2> 

WRITE  SOIL  CHARACTERISTICS 

IF<NSOIL,EQ.1  )URITE< I00UT,821  ) 

820  F0RMAT<15H  SILT  CONTENT  ,F5.2> 

821  F0RMAT</,15H  SOIL-1  > 

IF<NS0IL.EQ.2)URITE< I00UT,822) 

822  F0RMAT</,15H  SOIL-2  3 

WRITE< IOOUT,820)SILT 

URITE<  I00IJT,823)DS0D 

823  F0RMAT<21H  DEPTH  OF  SOD  , F5 . 2 > 


HT,F8.2,7H 


,F5.2> 


WRITE  EXPLOSIVE  CHARGE  CHARACTERISTICS 


IF<NCHRG.EQ. 

824  F0RMAT</,65H 
1  ON  GROUND 

IF<NCHRG.EQ. 

825  F0RMAT</,25H 
IFCNCHRG.EQ. 

826  F0RMAT</’,45H 
IFCNCHRG.EQ. 

827  format: 7, 45H 
IFCNCHRG.EQ. 

828  FORMAT</,40H 
URITE< lOOUT, 

829  FORMATOOH 
URITE< lOOUT, 

830  FORMATOOH 
FLAG=. FALSE. 


1  >WRITE< I00UT,824> 

SURFACE  -  LIVE  FIRE  OR  30  DEGREE  TILTED  STATIC, 
3 

2)WRITE< I00UT,8253 

BARE  CHARGE  ON  SURFACE  3 

33WRITE< I00UT,8263 

30  DEGREE  TILTED  TIP  AT  0.3  METER  DEPTH  3 

43WRITE< I00UT,8273 

30  DEGREE  TILTED  TIP  AT  0.6  METER  DEPTH  3 

33WRITE< I00UT,8283 

HORIZONTAL  PROJECTILE  ON  SURFACE  3 

8293CHWT 

WEIGHT  OF  CHARGE  ,F8.2,SH  KG.  3 

8303DETDEP 

DETONATION  DEPTH  ,F8.23 


COMPUTE  THE  ROTATION  TRANSFORMATION  MATRIX  TO  CONVERT  THE  USER 
DEFINED  COORDINATES  INTO  LOCAL  COORDINATES  WITH  THE  X-AXIS  IN 
THE  WIND  DIRECTION. 

S  CONTINUE 

IF  < .NOT.NEWATM3  GO  TO  45 
THET AX»THUMD*P I 7 1 8 0 . 

TRNFRM< 1 , 1 3-COS<  THETAX  3 


COM00700 
COM0071 0 
COM00720 
COM00730 
COM00740 
COM00750 
COM00760 
COM00770 
COM00780 
COM00790 
USEDCOM00800 
COM0081 0 
COM00820 
COM00830 
C0MCiu840 
COM  0  0.85  0 
COM00860 
COM 00870 
COM00S80 
COM00890 
COM  0  08 0  0 
,  COM00910 

COM00920 
COM00930 
COM  0  094  0 
COM00950 
COM00960 
COM00970 
COM009S0 
COM00990 
COM01 000 
COMO’ 01 0 
COM01 020 
COM01 030 
COM01 040 
COM01 050 
COM01 060 
COM01 070 
COM01 080 
COM01 090 
COM01 1 00 
COM01 1 1 0 
COM01 120 
COM01 130 
COM01 140 
COMOl 150 
TIP  COM0I160 
COMOl 170 
COMOl 180 
COMOl 190 
COM01200 
COM0121 0 
COM01220 
COM01230 
COM01240 
COM01250 
COM01260 
COM01270 
COM01280 
COM01290 
COM01300 
COM0131 0 
COM01320 
COM01330 
COM01340 
COM01350 


COH01360 

COM0I370 
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TRHFRM<  2 , 2 )=TRNFRH< 1 , 1 > 

TRNFRM< 1 , 2  )=SIN<  TMETAX  > 

TRNFRIK  2 , 1  )=-TRNFRM< 1 , 2  > 

MAKE  THE  ORIGIN  OF  THE  LOCAL  COOROINAT  SYSTEM  THE  FIRST 
CHARGE  LOCATION  THAT  WAS  INPUT  BY  THE  UiER 

DO  40 

SRCBAS< I )=C00R< I>  1  > 

ORIG<  I  >=SRCBAS<:  I  > 

40  CONTINUE 

CALL  SETUP  TO  COMPUTE  THE  ARRAY  OF  DIFFERENCE  VECTORS 

CALL  SETUP<NCHS,SRC8AS,SIDE1 ,SIDE2,TRHFRM) 

COMPUTE  COORDINATES  OF  THE  TRANSMITTER  AND  RECEIVER  IN  THE  LOCAL 
COORDINATE  SYSTEM 

TRN<3>=TRNC0R<3) 

REC<  3  j=RECCOR<  3 ) 

DO  60  1=1,2 
TRN< I >=0. 0 
REe<  I  >=0 . 0 
DO  50  J=1,2 

TRN< I >=TRN< I  )  +  TRNFRM< 1 , 

REC< I >=REC< I >+TRNFRM( I . 

50  CONTINUE 
60  CONTINUE 
5  CONTINUE 

CALL  PPETRN  TO  COMPUTE  THE  TRANSMITTANCE  ALONG  THE  SPECIFIED  LINE 
SIGHT 

CALL  PRETRMt  TRN, REC, TIME, TRNLOS ) 

999  RETURN 
END 


J)*<TRNCOR<  J)-ORIG< 

J  )♦<  RECCOR<  J  >-ORlG<  J  >  > 


OF 


COM01380 
COM01390 
COM01400 
COM0141 0 
COM 01 420 
COM0t430 
COM01 440 
COM01450 
COM0t460 
COM01470 
COM01 480 
COM01490 
COM01500 
COMOISI 0 
COM01520 
COM01530 
COM01540 
COM 0(550 
COM01 560 
COM0(570 
COM0i58u 
COM01590 
COM01600 
COM01 61 0 
COM01 620 
COM01630 
COM01640 
COM01650 
COM01660 

COM01670 
COM01680 
COM01690 
COM01700 
COM01 71 0 
COM01720 
COM01730 
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SUBROUTINE  COHLEHC U, Tft , HTTOP, HTBOT, XCEN, YCEN, RTOP , RBOT , XB, YB, 
1XN0RM,PLEN> 

ROUTINE  TO  FIND  THE  LENGTH  OF  A  NON-HORIZONTAL  LINE  THAT  INTERSECTS 
A  CONE 

INPUTS 

U  -  UNIT  VECTOR  ALONG  LINE  CONNECTING  THE  TRANSMITTER  AND 
RECEIVER. 

TR  -  TRANSMITTER  COORDINATES 

HTTOP-  HEIGHT  OF  THE  TOP  OF  THE  CONE  SHAPED  PORTION  OF  THE  CLOUD 

HTBOT-  HEIGHT  OF  THE  BOTTOM  OF  THE  CONE  SHAPED  PORTION  OF  THE 

CLOUD 

XCEN  -  X  POSITION  OF  THE  CENTER  OF  THE  CONE  SHAPED  CLOUD  AT  TOP 

YCEN  -  Y  POSITION  OF  THE  CENTER  OF  THE  CONE  SHAPED  CLOUD  AT  TOP 

RTOP  -  RADIUS  OF  THE  CONE  AT  THE  TOP 

RBOT  -  RADIUS  OF  THE  CONE  AT  THE  BOTTOM 

XB  -  X  POSITION  OF  THE  BOTTOM  OF  THE  CONE  SHAPED  CLOUD 

YB  -  Y  POSITION  OF  THE  BOTTOM  OF  THE  CONE  SHAPED  CLOUD 

OUTPUT 

PLEN  -  LENGTH  OF  THE  INTERSECTION  OF  CONE  AND  THE  LINE  OF  SIGHT 
FUNTIONS  AND  SUBROUTINES 
NONE 

III  3|I «  9|I1|C « >|i « Hem  ♦  iH  IK  %  «  4c 

DIMENSION  U<3>,TR<3) 

IF<U<3).LT. 0. 0)GO  TO  40 

SET  UP  BOUNDS  SO  INTERSECTION  OF  LINE  IS  SUCH  THAT  HTBOT  <  2  <  HTTOP 

PM IN=<  HTB0T-TR<  3  )  )XU<  3  > 

PMAX=<  HTTOP-TR<  3  >  >XU<  3  ) 

GO  TO  50 

40  PMIN=<HTT0P-TR<3.^>XU<3) 

PMAX=<  HTBOT-TR<  3  > )XU<  3  > 

50  P1*<HTT0P-HTB0T)/U<3) 

P0=<  HTBOT-TR<  3 ) >XU<  3 ) 

SET  UP  QUADRATIC  TO  BE  SOLVED 

DXi=U<  1  )>*>P1-XCEN+XB 

DY 1 »U<  2  J»P 1  - YCEN+YB 

DR-RTOP-RBOT 

A=>DX1  •♦2+DYl  *’*2-DR'«'*2 

DX0=TR<  1  >+U<  1  >"»P0-XB 

DY0-TR<2  >+U<2>-*P0-YB 

B*2 .  •<  DX 1  ♦DXO+DY 1  iiDYO-DR*RBOT  > 

C*'<  DXO‘*'»'2+DYO'**2-RBOT*'*'2  > 

RADIO i =<  DX1 ♦RBOT-DXOfDR  >♦*2 
RADIC2-<DY1*RBOT-DYO-»<DR>>*"*2 
RAD  I  C3-<  DX  1  *DY  O-DY 1  ♦DX  0  >i"*2 

DETERMINE  PATH  LENGTH  IF  THE  LINE  INTERSECTS  THE  CONE 

IF<A6S<A).LT. 1 .E-20>GO  TO  60 
RADIC-RADIC1 +RADIC2-RADIC3 


CNLCu330 
CHL00390 
CNL0001 0 
CNL00020 
CNL00030 
CNL00040 
CNlOOOSO 
CNL00060 
CNL00070 
CNL00080 
CNLOOOSO 
CNL001 00 
CNLOOi 1 0 
CNL00120 
CNLOOiSO 
CNLOOI 40 
CNLOOI 50 
CNL00160 
CNLOOI 70 
CNLOOI BO 
CNLOOI SO 
CNL00200 
CNL0021 0 
CNL 00220 
CNL00230 
CNL 00240 
CNL00250 
CNL00260 
CNL00270 
CNL00280 
CNL002S0 
CNL 003 00 
CNL0031 0 
CNL 00320 
CNL00330 
CNL00340 
CNL00350 
CNL00360 
CNL00370 
CNL 004 00 
CNL0041 0 
CNL00420 
CNL00430 
CNL00440 
CHL00450 
CNL00460 
CNL00470 
CNL00480 
CNL004S0 
CNL00500 
CNLOOSi 0 
CNL00520 
CNL00530 
CNL00540 
CNL00550 
CNL00560 
CNL00570 
CNL 00580 

cnlOosso 

CNL00600 
CNLOObt  0 
CNL00620 
CNL00630 
CNL00640 
CNL00650 
CNL00660 
CNL00670 
CNL006B0 
CNLOOSSO 
CNL00700 
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sUBkOUTINE  C0NVRT(T>  CuVuuOfO 

LOGICAL  SUI TCH j CHANGE  COV00020 

REAL  KZ,KX,N,MDIF  COV00030 

COMMON, ■'PRTINF2R0,VGRAV<  3  ),NPRTS  COV0  0  04  0 

COMMON, 'BUOyCL/'RSPH,DELT,V2SPH,XCMSPH,YCMSPH,ZCMSPH,XTOP,YTOP,  COV 0  0  050 

1 SPHNS< 3 > j R ISTIM  COV00060 

C0MM0N/CL0CK2T1ME,TWIND  COV00070 

C0MM0N,'TRAN2VTR, KZ,KX,TTR,XTR,2TR,QPUFF< 3 >, SWITCH, CHANGE  COV00080 

COMMON,-’SIG,-'SIG02,S1GC  COV00090 

COMMON  /lOUNIT/IOIN, lOOUT, IPHFUN , LOUNIT , ND IRTU , NCL I MT , KSTOR , NPLOTUCOV 0 0 1 00 


COMMON/GEOM/COSTHZ, SINTH, SINTH2. VISEXT, RTPI , SCRN<  2 ) 
COMMON,-'LOAD/'WAKAL ,  SPHAL 
COMMOH,-’WNDPRM,‘’DXZO,DY20,02  0,UO,M,ND1F,21HV 
COMMOH.-’STARS/USTAR,  TSTAR,2STAR 
COMMON/EKTEMP/’ZO,2L,TO,TC1  ,TC2,TC3 

COMMON,'WAKE/'XDIF,  YDIF,  2DIF,TOIF,TDX,  TD2,  QLOC ,  QCOL  ,  XBAVRG 
COMMON  /CONST/PI ,PI2,PIRAD,TW0PI,T0RRMB,CDEGK 

III  4i  41  >•>  4i  4i  %  ift  %  %  41  *  41 4i  ♦  %  %  %  %  %  %  411(1  ♦  4(  41  %  >|t  i4t  %  ><(  %  4c 

PURPOSE 

TO  CONVERT  THE  CURRENT  BUOYANT  CLOUD  INTO  A  THREE  DIMENSIONAL 
GAUSSIAN  PUFF  TO  BE  USED  BY  THE  WIND  DISPERSION  MODEL, 


INPUl 


TIME  IN  SECONDS  AFTER  DETONATION 


CALLED  BY  RISE 

FUNCTIONS  AND  SUBROUTINES  NEEDED 

WNDCAL 

AMOUNT 

AVRG 

*  4, m 4> 4i4i  4<  4<  m  4, 4i  »■* *  mu,  4,  Hi  « <0  «« «•  41  «>,«*«  4>  W 

CHANGE=.TRUE. 

TWIND-T 

VTR=USTARfWNDCAL<20,ZL,ZCMSPH) 

KZ»DIFFUS<  20, ZL, ZCMSPH ) 

KX=K2*DXZ0 

TTR=T 

XTR=XCMSPH 

ZTR=ZCMSPH 

DO  10  IPRTS-1 ,NPRTS 

QPUFF< IPRTS  >=SPHNS< IPRTS ) 

1 0  CONTINUE 

V0LSPH=<4,/'3  .  )fPI»RSPH>»i'3 
CALL  AMOUNT<VOLSPH,WAKAL, SPHAL > 

QPUFF<  1  )=>SPHAL 

60  SIG02=<<2./’3.  >fRSPH)ff2 
SIG0=>OQRT<SIG02> 

2X=5. 0 

61  CALL  AVRG<ZX,T,QTOT, XBAVRG  SIG2X,SIG2Y> 

SICX=SQRT<S1G2X) 

SIGY=SeRT<81G2V  > 

COMPUTE  PARAMETERS  NEEDED  FOR  LOCAL  AND  COLUMN  DENISTY  FOR  THE  UAKE 
SOLUTION 

3IGC>‘<  SQRT<  3ICX«SIGY  SQRT<  SIC02  >  )/2 . 

XDIF-XCMSPH-XBAVRG 
YDIF=YCMSPH 
2D1F-2CMSPH-5. 0 
TD1F=SIGC**2,,'KX/2. 

TDX^Z.fKX 

TD2-2.*KZ 

QL0C=UAKAL/4./'PI/'SQRT<2.  > 


COV001 1 0 
COV00120 
COV001 30 
COV00140 
COV00150 
COV00160 
COV001 70 
COV00180 
COVOOi 50 
COV00200 
COV002t  0 
COV 00220 
COV00230 
COV0024U 
COV 00250 
COV00260 
COV00270 
COV00280 
COV00250 
COV 00300 
COV 003) 0 
COV 00320 
COV00330 
COV00340 
COV00350 
COV 00360 
COV00370 
COV 00380 
COV00390 
COV00400 
COV004 1 0 
COV00420 

COV00430 
COV00440 
COV00450 
COV00460 
COV00470 
COV00480 
COV00490 
COV00500 
COV0051 0 
COV 00520 
COV00530 
COV00540 
COV 00550 
COV00560 
COV00570 
COV00580 
COV00590 
COV00600 
COV006t  0 
COV00620 
COV00630 
COV00640 
COV00650 
COV 00660 
COV00670 
COV00680 
COV00690 
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QC0L=WAKAL^4./SQRT<PI > 
998  RETURN 
END 


COVOOPOO 
COV0071 0 
COV00720 


ooo  ooor*  oooooooooooooooooooooo 


PUNCTION  CSPHEft<:X,y,2,T> 


COMPUTE  EITHER  THE  COLUMN  DENSITY  FOR  A  GIVEN  LINE  OF  SIGHT  OR 
COMPUTE  THE  LOCAL  CONCENTRATION  AT  X,V,2  FOR  THE  SPHERE 

INPUT 


X,  Y,Z 


COORDINATES  IN  METERS.  IF  LINE  INTEGRAL  IS  DESIRED, 
Y  IS  IGNORED  AND  LINE  IS  SPECIFIED  BY  X  AND  Z. 

THE  TIME  IN  SECONDS  AFTER  DETONATON 


CSPu0230 
CSPOOOl 0 
CSP00020 
CSPCI0030 
CSP00040 
CSP00050 
CSP00060 
CSP00070 
CSP00080 
CSP00090 
CSP001 00 
CSP001 i 0 
CSP001 20 
CSP001 30 
CSPOOi 40 
CSP00150 
CSPOOI 60 
CSP00170 
CSPOOiaO 
CSPOOI 90 
CSP00200 
CSP002 1 0 


OUTPUT 


RETURNS  THE  CONCENTRATION  AT  X,Y,Z,T  IF  HORiZ  IS  .FALSE.  AND 
THE  LINE  INTEGRAL  OF  CONCENTRATION  < COLUMN  DENSITY)  IF  HORIZ 

IS  .True. 

FUNTIONS  AND  SUBROUTINES  CALLED 
NONE 


REAL  M,N,K2,KX 
LOGICAL  HORIZ, SWITCH, CHANGE, TEST 
COMMOH,''PRTINF/  RO,  VGRAV<  3  ),  NPRTS 

COMMON  /GEOM/COSTHZ, SINTH, SINTH2, VISEXT,RTPI , SCRN<  2  > 
COMMON  ZMODEZ  HORIZ 

COMMON  /'WNDPRM/DXZ0,DYX0,D20,U0,M,N,2INV 

COMMON/DISCS/NOSCS, TDSC<  20 ),XDSC<  20  >, 2DSC<  2 0  >,  R2DSC<  2 0  >, 
\  QDSC<20,3> 

COMMONZMO5/DlFF<2,200),NCHTOT,PRSeP<2O0>,NTOT,HARY, ITOT, 
+  COOR<2,200>,TSTAG<200),DMMy<401  > 

COMMON, •'TRANXVTR ,  KZ ,  KX ,  TTR  ,  XTR .  ZTR .  QPUFF<  3  > ,  SW I TCH ,  CHANGE 
COMMONZSIG/S1C02,SIGC 


CSP00240 
CSP00250 
CSP00260 
CSP00270 
CSP00280 
CSP 00290 
CSP00300 
CSP0031 0 
CSP 00320 
CSP00330 
CSP00340 
CSP00350 


COMMON  /lOUNIT/IOIN, lOOUT, IPHFUH, LOUNIT, NDIRTU, NCL IMT , KSTOR , NPLOTUCSP00360 


COMMON/LOADXWAK AL , SPHAL 
COMMON/ACL/CWINDS, CWINDC, CWIHDW 

CQMMON.''UAKE/X01F,VDIF,2OIF,TDIF,TOX,TDZ,QLOC,QCOL,XBAVRG 
COMMON/LOSZTR<  3 ) , RE<  3 ),  U<  3  > 

COMMON/'CHARGE/'NCHG 

COMMON,^TRANNY/THRESH ,  TEST ,  NWL ,  NSOIL 
COMMON  XCONST/P I , P 12 , P IRAO , TWOP I , TORRMB , COEGK 
CSPHER-0. 0 
CWNDSC-0. 0 
CWINOC=0. 0 
IF<NARY,EQ. 

IF<<T-TTR), 


3>G0  TO  999 

LT. 1 .E-20>GO  TO  999 


COMPUTE  CONTRIBUTION  FROM  BUOYANT  CLOUD  AFTER  SWITCHING  TO  THE 
WIND  MODEL  USING  A  THREE  DIMENSIONAL  GAUSSIAN  PUFF 

SIGX2=31C02+2 . ♦KX-K  T-TTR ) 

31  G22«r  SIC02+2  ■  1•KZ♦<  T-TTR  ) 

S!gX-SuRT(  3ICX2 ) 

SIG2=SQRT<SIG22) 

ARG2“<  2-2TR  >**2Z<  2 
1F<ABS<ARG2).CT.30 
TERM2»EXP< -ARG2) 

GO  TO  26 
TERM2-0. 0 

ARG3=<2^ZTR>>**2Z<2 
1F< ABS< ARG3  ) . GT . 30 , >GO 
TERM3«EXP< -ARG3) 

GO  TO  28 
TERM3-0. 0 
if<:horiZ)CO  to  so 


25 

26. 


27 

28 


«31G22> 
>C0  TO  25 


■»SIGZ2> 

■  TO  27 


COMPUTE  CONCENTRATION  AT  X,Y,Z 


CSP00370 
CSP00380 
CSP00390 
CSP00400 
CSP0041 0 
C3P00420 
CSP00430 
CSP00440 
CSP 00450 
CSP00460 
C3P00470 
CSP00480 
C3P00490 
CSP00500 
C3P0051 0 
CSP00520 
CSP 00530 
C3P00540 
C3P00550 
CSP 00560 
CSP00570 
CSP005SO 
CSP00590 
CSP 006 00 
CSPOub f  0 
CSP 00620 
CSP00630 
CSP00640 
CSP00650 
CSP00660 
CSP00670 
CSP00630 
CSP00690 
CSP00700 
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ooo 


xc=xtr+vtr*«:t-ttr>+diff<  i  ,nchg> 

YC=DIFF<  2,NCHG  ) 

ARG1  =<  <  X-XC  +  <  Y-YC  >*>f2  >X2  .  /SIGX2 
IF<ABS<ARG1  ).GT.30. >G0  TO  999 
TERM=3PHALX<<2.-*PI  ><»i'<3.X2.  >  >/'SIG2XSIGX2 
CWINDC=TERM*EXP< -ARG1  )*<  TERH2+TERH3> 

GO  TO  100 

COMPUTE  COLUMN  DENSITY 

50  TERM=3PHAL/’2./’PIXSIGXXSlGZ 
DO  90  I=l.NCHTOT 
XC=*XTR+VTR*<  T-TTR  >+DIFF<  1,1) 

YC«DIFF<  2, I > 

XY=XC>*SCRN<  1  >+YC>*-SCRN<  2  > 

PRG1  =<  X-XY  >*>*2X2  .  XSIGX2 
IF< AB3< ARGl ) . GT . 30 .  iGO  TO  90 
CUNDSC»TERMi>EXP<  -PRG 1  >•<  TERM2+TERH3  ) 
Ci«IINDC=CUINDC+CUNDSC 
CALL  TRNCHk<CWINDS,CWINDW,CWINDC  > 
IF<TEST>GO  TO  999 
90  CONTINUE 
100  C3PHER=CU1NDC 
999  RETURN 
END 


MS 


CSP0071 0 
CSP00720 
CSP00730 
CSP 00740 
CSP00750 
CSP00760 
CSP00770 
CSP007S0 
CSP00790 
CSP 008 00 
CSP 0081 0 
CSP 00820 
CSP00830 
CSP00840 
CSP00850 
CSP008S0 
CS^00870 
CSP00880 
CSP 00890 
CSP00900 
CSP0091 0 
CSP00920 
CSP00930 
CSP 00940 
CSP00950 


ooo  oooo  r»oooririr*r.iooooooooooonoorjonoon 


FuHCTlOH  CWHt<E<  X , y , 2 , T  i  Cy^)uu29u 

CUIA0001  0 

FUNCTION  TO  COMPUTE  THE  LOCAL  CONCEHTRATIOH  OR  COLUMN  DENSITY  AT  CidAOuOiO 

X,Y,Z  AND  TIME  T  AFTER  THE  BLAST  FOR  THE  WAKE,  CWA00030 

CWA00040 

CWA00050 

INPUT  CWAOOObO 

CUA00070 

X,Y,Z  COORDINATES  IN  METERS.  IF  THE  LINE  INTEGRAL  IS  DESIRED  CWAOOOSO 
THESE  ARE  NOT  USED  AND  THE  LINE  IS  SPECIFIED  BY  THE  CWAOOOSO 

TRANSMITTER  AND  RECEIVER  COORDINATES  AND  INFORMATION  CUAOOl 00 

CALCULATED  AT  THE  TIME  THE  BUOYANT  FIREBALL  CONVERTED  CWAOOl 1 0 
TO  THE  WIND  MODEL.  CWAOOl 20 

CWAOOl 30 

T  THE  TIME  IN  SECONDS  AFTER  DETONATION  CWA00140 

CWAOOl 50 
CWAOOl 60 

OUTPUT  CWA00170 

CWAOOISO 

RETURNS  THE  CONCENTRATION  AT  X,Y,Z,T  IF  H0RI2  IS  .FALSE.  AND  CWAOOISO 

THE  i-INE  INTEGRAL  OF  CONCENTRATION  <C0LUMN  DENSITY)  IF  CWA00200 

HORIZ  IS  .TRUE.  CWA00210 

CWA00220 
CWA 00230 

FUNCTIONS  AND  SUBROUTINES  NEEDED  CWA00240 

CWA 00250 

ERF  COMPUTE  THE  ERROR  FUNCTION  CWA00260 

CWA 00270 

REAL  M.N.K2,KX  CWA00300 

LOGICAL  HORIZ, SWITCH, CHANGE, TEST  CWA00310 

COMMON.-'PRTINFZ  RO,  VGRAV<  3  >,  HPRTS  CWA00320 

COMMON  ZGE0MyC0STH2,SINTH,SINTH2,VISEXT,RTPI,SCRN<2)  CWA0C330 

COMMON  /MODE/  HORIZ  CWA00340 

COMMON  /'WNDPRMZDXZ0,DYX0,D20,UO,M,N,ZINV  CWA00350 

COMMONZDISCS/NDSCS, TDSC<  20 ), XDSC< 20 ), ZDSC<  20  >, R2DSC<  20  >,  CWA0  036  0 

1  QDSC<20,3)  CWA 00370 

COMMON,-'MO5/DIFF<2,20O>,NCHTOT,PRSEP<200>,NTOT,NARY,  ITOT,  CWA 0  0380 

+  COOR<2,200>,TSTAG<200.),DMMY<401  )  CWA00390 

C0MM0N/TRAN7VTR ,  KZ ,  KX ,  TTR , XTR ,  ZTR ,  QPUFF<:  3  > ,  SWITCH ,  CHANGE  CWA 0  0400 

COMMON/SIGZSIG02,SIGC  CWA004t0 

COMMON  /lOUHlTZIOlN, lOOUT , IPHFUN, LOUNI T, ND IRTU , NCL I MT , KSTOR , NPLOTUCWAO 042 0 


FUNCTION  TO  COMPUTE  THE  LOCAL  CONCEHTRATION  OR  COLUMN  DENSITY  AT 
X,Y,Z  AND  TIME  T  AFTER  THE  BLAST  FOR  THE  WAKE, 


INPUT 


X,  Y,Z 


COORDINATES  IH  METERS.  IF  THE  LINE  INTEGRAL  IS  DESIRED 
THESE  ARE  NOT  USED  AND  THE  LINE  IS  SPECIFIED  BY  THE 
TRANSMITTER  AND  RECEIVER  COORDINATES  AND  INFORMATION 
CALCULATED  AT  THE  TIME  THE  BUOYANT  FIREBALL  CONVERTED 
TO  THE  WIND  MODEL. 


THE  TIME  IN  SECONDS  AFTER  DETONATION 


OUTPUT 


RETURNS  THE  CONCEHTRATION  AT  X,Y,Z,T  IF  HORIZ  IS  .FALSE.  AND 
THE  i-INE  INTEGRAL  OF  CONCENTRATION  <COLUMN  DENSITY)  IF 
HORIZ  IS  .TRUE. 

FUNCTIONS  AND  SUBROUTINES  NEEDED 

ERF  COMPUTE  THE  ERROR  FUNCTION 


COMMON/LOAD/WAKAL,SPHAL  CWA00430 

COMMON/ACL^CWINDS,CWINDC,CWINOW  CWAno44n 

C0MM0N/WAKE7XDIF,YD1F,ZDIF,TDIF,TDX,TDZ,QL0C,GC0L,XBAVRG  CWA 00450 

C0MM0N,-’L0S2TR<  3  ) ,  RE<  3  ) ,  UC  3  )  CWAO  0460 

COMMONZCHARGE/'NCHG  CWA00470 

COMMON/'TRANNY/THRESH.TEST,NWL,NSOIL  CWAO  048  0 

COMMON  ZCONST/'PI,PI2,PIRAD,TWOPI,TORRMB,CDEGK  CWA00490 

IF<NARY.EQ.3)G0  TO  999  CWA00500 

IF<<T-TTR).LT. 1 .E-20>GO  TO  999  CWA00510 

CWA 00520 

COMPUTE  CONTRIBUTION  FROM  THE  WAKE  AFTER  SWITCHING  TO  THE  WIND  MODEL  CWA00530 
FOR  A  SINGLE  CHARGE  CWA00540 


CWAKE=0, 0 
CWINDW'^O.  0 
CWNDSW=0. 0 

3IGX2=TDXf<TDIF+<T-TTR)) 

SIGZ2=TDZ*<T-TTR) 

IF<H0RI2)G0  TO  210 
XB=XBAVRG+DIFF< 1 ,NCHG) 

YB=DIFF<2,NCHG) 

COMPUTE  THE  LOCAL  CONCENTRATION 

A=-<  XDIF*^2  +  YDIF**2  )/2 . /SIGX2-<  2DIF**2/2 . /SIGZ2  > 
XX=X-VTR*<  T-TTR  > 

B0=<  XDIFf<  XX-XB  )+YDIFii<  y-vB  )  )/SICX2 
Bl=B0+<2DlF>*<2-5.  )/81G22> 


CWA00540 
CWA 00550 
CWA 00560 
CWA00570 
CWA 00580 
CWA00590 
CWA 006 00 
CWA0u61 0 
CWA 00620 
CWA00630 
CWA 00640 
CWA 00650 
CWA 00660 
CWA00670 
CWA0D6S0 
CWA00690 
CWA00700 
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B2=B0-<ZDrFf<2+5.  )/SICZ2>  CU|!>007JO 

C0=-<  <  XX-XB  >*%2+<  Y-YB  >t"*a  )/2  .  /'SIGX2  CWA00720 

C1=C0-<:<2-5.  >t»f2,^2./'SlG22)  CUA00730 

C2=C0-<<2+5.  )**2/2 . /SlGZa >  CWA00740 

RTrttt=3QRT< -A  >  CmIA0u7du 

ARG1*C1-<B1>**2/'4./'A>  CWA00760 

ARG2=-Bt/’2./RTMA  CWh0077o 

ARG3=RTMA+ARG2  CulA00780 

»hQ4=C2-<B2*<*2/4  ./»')  CiiiAu079u 

ARG5=-B2/'2./'RTMA  CWAOOSOO 

hRG6=RTHA+ARG5  CUA00810 

IF<ARG1 .LT.-30. >GO  TO  221  CWA00a20 

TERM1=EXP<  ARG1  ERF<  hRG3  3-ERF<:  ARG2  >  >  CUftOOSSO 

GO  TO  222  CUA00d40 

221  TERrl1=u.O  CiJAOOSSu 

222  CONTINUE  CUIA0OS6O 

iF< ARG4 . LT . -30 .  iGO  TO  223  CWA0087U 

TERM2=EXP<  ARG4  >•<  ERF<:  ARG6  >-ERF<  ARCS  >  >  CWA00S80 

GO  TO  224  CUA0u890 

223  TERM2=0.0  CWA0Ci900 

224  CWAKE=QL0C/^SIGX2XSeRT<SIG22>/’RTMA*<TERMl+TERM2>  CiilA0091  0 

GO  TO  999  CWA00920 

CiilA00930 

COMPUTE  COLUMN  DENSITY  CWA00940 

CliiA0u950 

210  DO  245  J«1,NCHTOT  CWA00960 

XB=XBAVRG+DIFF< 1 , J>  CWA00970 

YB=DIFF<2,J)  CWA00980 

230  A— <XDIF^U<2)-Y0IFt.U<  t  )  )'**2/’2  . /'SIGX2-<  2DIF  >>*>»'2/’2  , /SIGZa  CWA00990 

TRR=TR< 1  )-VTRf<T-TTR)  CWA01 000 

B0=<  YDIF*U<  1  >-XDIF>t.U<2))*<<TR<2)-yB)*U<  I  )-<  TRR-XB  >#U<  2  >  >/SICX2  CWA01  01  0 
Bl=B0+2DIF*<TR<3>-5,  J/SIGZa  CWA01020 

B2-B0-ZDIF*<TR<3>+5. >/SIG22  CUA0f03O 

CO— <<TR<2>-YB>*U<  1  >-<TRR-XB)*U<2>)'»*2/'2,/SlGX2  CWAOl  040 

Cl =C0-<  TR<  3  )-5 .  )**2/2 . 7S1G22  CWAOl 050 

C2»C0-<TR<3)+S. >**2/2,/SIQZ2  CWAOl 060 

RTHA=SQRT<-A)  CWAOl 070 

ARG1*>C1-B1**2X4./A  CWAOl  080 

ARG2=-B1/'2./’RTMA  CWAOl  090 

ARG3sRTMA>ARG2  CWAOIIOO 

ARG4=C2-B2f>*274.7A  CWAOl  110 

ARGSa-Baxa.^RTMA  CWAOllZO 

ARC6=RTMA+ARG5  CWAOl 130 

IF<ARG1 ,GT.30. )ARG1«30.  CWA01I40 

IF<:ARG1  .LT.-30.  >GO  TO  231  CWA01150 

TERM1=EXP<  ARG1  )>»<  ERF<  ARG3  )-ERF<  ARG2  >  >  CWAOl  160 

GO  TO  232  CWAOl 170 

231  TERMI^O.O  CWAOl 180 

232  CONTINUE  CWAOIISO 

IF<ARG4.LT.-30. >GO  TO  233  CWA01200 

TERM2=EXP<  ARG4)t><ERF<ARG6>-ERF<ARG5))  CWA0121  0 

GO  TO  234  CWAOl 220 

233  TERM2*0.0  CWAOt230 

234  ARG=°S1GX2*3'GZ2  CWAOl  240 

CWNDSW=<  QCOLXSQRT<  ARG i/RTMA )*<  TERM1 +TERM2 )  CWA 0 1 250 

240  CONTINUE  CWA01260 

CWlNDW-CWINDW-tCWNDSW  CWAOl  270 

CALLTRNCHKCCWIMDS^CWINDW^CWINDC)  CWAOl 280 

IF<TEST)GO  TO  999  CWAOl 290 

245  CONTINUE  CWA01300 

CWAKE>CWINDW  CWAOl 310 

999  RETURN  CWAOl 320 

END  CWA01330 
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PUNCTiOM  CUIMDc X , y , Z , T > 

PURPOSE 

TO  COMPUTE  THE  CONCENTRATION  AT  A  POINT  OR  INTEGRATED  ALONG 
A  HORIZONTAL  LINE  < SKIRT  PORTION  OF  DUST  CLOUD) 


INPUT 
X,  Y,2 


OUTkUT 


COORDINATES  IN  METERS.  IF  LINE  INTEGRAL  IS  DESIRED. 
Y  IS  IGNORED  AND  LINE  IS  SPECIFIED  BY  X  AND  Z. 

THE  TIME  IN  SECONDS  AFTER  DETONATION 


RETURNS  THE  CONCENTRATION  AT  X.Y.Z.T  IF  HORi: 


THE  LINE  INTEGRAL 
SUBROUTINES  CALLED 


CONCENTRATION  IF  HORIZ 


.FALSE . 


,  TRUE , 


MOMENT 


COMPUTES  ZERO  ORDER  MOMENT  AND  INTERPOLATES  FROM 
TABLE  OF  HIGHER  ORDER  MOMENTS. 


CALLED  BY  FUNCT.TRNCAL  Cull 

Ckll 

REAL  M.N.KZ.KX  CWI 

LOGICAL  H0R1Z,SWITCH,CHANGE,TEST,SKIP  CUI 

DIMENSION  REF<2).REF0<2)  CUII 

C0MM0N2PRTINF/  RO ,  VGRAV<  3  ) .  NPRTS  CUII 

COMMON  /'CE0M/C0STM2,SINTH.S1NTH2,VISEXT.RTPI,SCRN<2)  CWI 

COMMON  /M0DE2  HORIZ  CUII 

COMMON  2U)NDPRM/DX20.DYX0,DZ0,U0.M.N.ZINV  CUII 

C0MM0N2DI3CS/NDSCS.  TDSC<  2 0  ) ,  XDSC<  2 0  ) ,  ZDSC<  2 0  > .  RZDSCC  2 0  ) ,  CUII 

1  QDSC<20.3)  CUII 

COMMON, ■'M05/DIFF<  2. 200  ).NCHTOT,PRSeP<  200  >,HTOT,  NARY,  ITOT.  CWI 

+  COOR<2,200>,TSTAG<200),DMMY<401 >  CWI 

COMMONXTRAN/'VTR,  K2,KX,TTR,XTR,  2TR,QPUFF<  3  ),  SWITCH,  CHANGE  CUII 

COMMON/SIGKSIG02,SIGC  CWI 

COMMON  2I0UNIT/I0IN, I OOUT , IPHFUN , LOUNI T , ND IRTU , NCL 1 MT , KSTOR , NPLOTUCWI 
COMMON, 'LOAD/WAKAL,SPHAL  CWI 

C0MM0N/ACLKCWIHDS,CW1NDC,CWINDW  CWI 

COMMON,'’WAKE/'XDIF,  YDIF,ZDIF,TDIF,TDX,TD2,QL0C,QC0L,XBAVRG  CWI 

C0MM0NXL0S/'TR<3),RE<3),U<3)  CUI 

COMMON/CHARGE/NCHG  CWI 

COMMON/’TRANNY/THRESH,TEST,NWL,NSOIL  CWI 

COMMON.-'SKIPIT/SKIP  CWI 

COMMON  /CONST/PI, F 12, PIRAD,TWOPI,TORRMB,CDEGK  CWI 

CWI 

COMMON  2PRTINF2  CUII 


RO 

VGRA'' 


NPRT5 


INITIAL  RADIUS  OF  THE  CLOUD  IN  METERS 
SINGLY  DIMENSIONED  ARRAY.  VGRAV< I >  IS  THE  OPTICALLY 
WEIGHTED  AVERAGE  SETTLING  VELOCITY  FOR  PARTICLES  IN  THE 
I  SIZE  RANGE 

THE  NUMBER  OF  PARTICLE  SIZE  RANGES 


COMMON  XDISCSX 


ND3CS 

TDSC 


R2DSC 


THE  NUMBER  OF  DISC  SOURCES 

SINGLY  DIMENSIONED  ARRAY  CONTAINING  THE  TIME  OF  RELEASE 
OF  THE  DISC  SOURCES 

SINGLY  DIMENSIONED  ARRAY  CONTAINING  THE  X  COORDINATE 
OF  THE  CENTER  OF  THE  DISC  SOURCES 

SINGLY  DIMENSIONED  ARRAY  CONTAINING  THE  Z  COORDINATE 
OF  THE  CENTER  OF  THE  DISC  SOURCES 

SINGLY  DIMENSIONED  ARRAY  CONTAINING  THE  SQUARE  OF  THE 
RADII  OF  THE  DISC  SOURCES 

DOUBLY  DIMENSIONED  ARRAY,  QDSC< I , J >  IS  THE  OPTICALLY 


0  0270 
0C01  0 
u  0  02  0 
0  0  03  0 
0  0  040 
0  0  050 
0  0  060 
0  0u70 
OOOSu 
0  0  090 
00100 
0  0110 
0  012  0 
0  0130 
0  014  0 
0  0  1  s  0 
0  016  0 
0  017  0 

0  0  i  so 
0  019  0 
0  0200 
0  021  0 
0  0220 
0  023  0 
00240 
0  025  0 
0  0260 
0  026  0 
00290 
00300 
0031  0 
00320 
00330 
0  034  0 
00350 
00360 
00370 
00380 
00390 
00400 
0041  0 
00420 
00430 
00440 
00450 
00460 
0  047  0 
00480 
00490 
00500 

0  05 1  0 
0  0320 
0  053  0 
0  054  0 
0  055  0 
00560 
0  057  0 
0  05SO 
00590 
0  0600 
006  f  0 
0  062  0 
00630 
00640 
00650 
00660 
00670 
00680 
00690 
00700 
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non  onn  ono  ooo  0000000 


WEIGHTED  HASS  OF  PARTICLES  OF  THE  J  SI2E  RAHGE  IN  THE 
1  DISC. 


SUM  THE  CONTRIBUTIONS  OF  THE  DISC  SOURCES  TO  THE 
OPTICALLY  WEIGHTED  CONCENTRATION  AT  <X,Y.2.T) 

CWIND=0- 
CUINDSC»0 , 0 
CU INDSaO . 0 
CUInDC=0 . 0 
CWINDW=0. 0 
IFtH0RI2>G0  TO  110 

COMPUTE  CONCENTRATION  AT  X,Y,2  < FOR  SIMULTANEOUS  BURST) 


50 


1)4 


DO  100  I-t,NDSC3 
REFO< 1 )=XDSC< I ) 

REF0<  2  )=0 . 0 
R0H2=R20SC< I  ) 

H=ZDSC< I  ) 

TOF=T-TDSC< I > 

DO  90  J=1^NPRT3 

DETERMINE  MOMENTS  FOR  CURRENT  SOURCE  DISC  AT  2 

CALL  MOMENTA  VGRAV<  J ) , 2 . H , TOF , Q , XBAR , S 1 CU2 , S I GP2  > 
IF<Q,GT. 1 .E-10>GO  TO  50 
CWNOSC=0. 0 
GO  TO  100 
CONTINUE 

RX2=R0H2+2.>*SIGW2 
RYa-ROHa+a.-^siGPB 
DO  114  NA*1 ,2 

REF<  NA  >»REF  0<  HA )+D IFF<  NA ,  NCHG  > 

CONTINUE 

ARG=-<X-REF<  1  )-XBAR  >*x-2XRX2 
IF<ABS<ARG).GT.30. >GO  TO  100 
CUNDSC*<  Q/RTP  I/SQRT<  RX2  )  )'»EXP«:  ARC  ) 

ARG=-<  Y-REF<  2  > )**2/RY2 
IF<ABS<ARG).GT.30, >GO  TO  100 
CY=EXP<ARG  )<-’RTPIXSQRT<RY2> 

CUNDSC=QOSC< I , J IfCWNDSC^CV 
CWINDSaCMINDS+CWNDSC 
CONTINUE 
CONTINUE 
CWIHD=CWIHDS 
GO  TO  999 

DO  220  ICHG*1 ,NTOT 
rF<T.LT,TSTAG< ICHG))GO  TO  220 
DO  21 1  1=1 ,NDSCS 
TOF=T-TDSC< I >-TSTAG< ICHG  ) 

REF0< 1 )=XDSC< I > 

ReF0<;2>=0, 

R0H2=R2DSCt I ) 

H=2DSC< I > 

IFCHORIZ)  REF0< 1  )-REF0< 1 >=8INTH 
DO  210  J»1,NPRTS 
CUNDSC=0. 0 


90 
t  00 


110 


DETERMINE  MOMENTS  FOR  CURRENT  SOURCE  DISC  AT  2 

CALL  MOMEHT<VGRAV<  J)i2,H,T0F,Q,XBAR,91CW2,SIGP2> 
IF<Q.GT, 1 ,E-1 0)  CO  TO  1 13 

IF  Q  IS  TOO  SMALL,  ITS  CONTRIBUTION  IS  IGNORED 

CUNDSC-0. 

CO  TO  210 
113  CONTINUE 


CWI0071 0 
GUI  00720 
GUI  00750 
CUII00740 
CUI 00750 
CW I  00760 
CUI00770 
CW I  0  0780 
CWI 00790 
CW I  00800 
CWI 0081 0 
CWI 00820 
CWI 00830 
CWI 00840 
CWI 00850 
CWI00860 
CWI00870 
CWI00880 
CWI 00890 
CWI 00900 
CWI 0091 0 
CWI00920 
CWI 00930 
CWI 00940 
CWI 00950 
CWI 00960 
CWI00970 
CWI0C980 
CWIU0990 
CWIOt  000 
CW101 01 0 
CWIOt  020 
CW10t030 
CWI01 040 
CWIOt  050 
CWI01 060 
CWI01 070 
CWID1 080 
CWI01 090 
CWI01 1 00 
CWI01 110 
CWI01 120 

cuionso 

CWI01 140 
CWI Of  ISO 
CW101 160 
CWI01 170 
CWIG1 180 

cwionso 

CU101200 
CWI0t21 0 
CW10t220 
CWI01230 
CWI01240 
CWI01250 
CWI01260 
CWI01270 
CW101280 
CWI01290 
CWI01300 
CU10131 0 
CWI01320 
CWI0t330 
CWI01340 
CWI01350 
CUI01360 
CWI01370 

cuioiseo 

CWI0t390 

CWI01400 
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4 


C 

c 

c 


DO  200  MA=<,NCHTOT 
INDX=MA 

IF<HhRY.EQ.3>INDX=ICHG 
RX2=R0H2+2,*SIGW2 
RY2-R0H2  +  2  .>fSIGi='2 

COMPUTE  COHCENTRATIOH  ALONG  LINE  OF  SIGHT  SPECIFIED  BY  X,Z 
120  CONTINUE 

REF( 1  >=REF0<  1  >+PRSEP< INDX ) 

REFF2=RX2*SINTH2+RY2*G0STH2 

ARG=-<X-REF<  1  >-XBhR>*.5IHTH)**2/'REFF2 

IF< «BS< hRG > . GT . 30 .  >00  TO  150 

CWNDSC=EXP<:  ARG  >  /'SORT<  REFF2  >XRTPI 

CUNDSC=CUNDSC>t‘U>fQOSC<.'  I ,  J  > 

150  CONTINUE 

CUINDS=CU1NDS+CWNDSC 

IF<3KIP)GO  TO  ISO 

CALL  TRNCHK<CWIND3,CUINDU,CUINDC> 

1F<TEST>G0  TO  999 
190  CONTINUE 
200  CONTINUE 

210  CONTINUE 

211  CONTINUE 
220  CONTINUE 

CWINDaCUINDS 
999  RETURN 
END 


Gill  I  0 1 4 1  0 
CUI 01420 
CWI01430 
CWI01440 
CUI 01 450 
CUI014G0 
CWI0t4?0 
CWI01480 
CUI 01 490 
CWI01500 
CU10151 0 
CWI01520 
CUl 01 530 
CWI01540 
CWI 01 550 
CWI01560 
CWI 01 570 
CWI  01 560 
CWI01590 
CW101600 
CWIOlBI 0 
CUI01620 
CWI 01 b30 
CW101340 
CWI 01 bSO 
CUI01660 
CW1U1670 
CU101680 


( 
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0000000000000000000000000000000000000000000 


SUBROUTINE  OIFEQ< N , T , Y, YP > 

RERL  KM.KZ.KX 
LOGICAL  SWITCH, CHANGE 
DIMENSION  Y<N),YP<N> 

COMMON/PRTINF/'R  OCL ,  VGRAV<  3  ) ,  NPRTS 
COMMON/WNDPRM/DX20 , DYXO , DZO , UO . UM , DN, 2INV 
COMMON  /ARRAY/OVREAP, AREA.PERIM .PRJARY,CENDIF 
COMMON/MOS/DIFFC  2, 20  0  ), NCHTOT, PRSEP<  2  00  >, NTOT, NARY, ITOT, 
+  DMM<600>,DMMY<401  ) 

COMMON  /'BURST/  ACCEL,  TBURST 
COMMON/STARS/USTAR, TSTAR, ZSTAR 
COMMON/EKWIND/ALP, C,PYF,PXF,UHAT,VHAT 
COMMON/EKTEMP/'2  0,2L,  T0,TC1  ,TC2,TC3 

COMMON/TRAN/VTR , K2 , KX , TTR , XTR , 2TR, QPUFF<  3  > , SWITCH , CHANGE 
COMM0N/SIG/3IG02,SIGC 


DFQOOOI 0 
DFQ00020 
DFQ00030 
DFQ00040 
DFQ00050 
DFQ00060 
DFQ00070 
OFQ00080 
DFQ00090 
DFQ001 00 
DFQ001 1 0 
DFQ00120 
DFQ00130 
DFQ00140 
DFQ00150 


COMMON  /lOUNlT/IOIN, lOOUT, IPHFUN, LOONIT , NO IRTU , NCLI MT , KSTOR , NPLOTUDFOO 0 1 60 


DATA  ALPHAK/'.25/’ 

«  *  >)■ « >t< i«  «  m  «  *  «  «  «  «  Hi  !(<  XI  Di «  *  «  *  X<  >X  « « >k  >t<  >MI<  %  41 «  *  « >*  ■)<  *  >*  « >)•  I*  « *  »  *  »  *  W  » I*  >••  >«  >t>  *  *  I*  f 

PURPOSE 

DIFEu  CONTAINS  THE  PARTIAL  DIFFERENTIAL  EQUATIONS  FOR  THE 
RISE  OF  A  BUOYANT  CLOUD  WHICH  ARE  USED  BY  SUBROUTINE  RKM . 


INPUT 

N 

T 

Y<  1  ) 
Y<2) 
Y<3> 
Y<4  ) 
Y<5) 
Y<6) 
Y<7) 
Y<8) 


OUTPUT 


THE  NUMBER  OF  DEPENDENT  VARIABLES 
THE  INDEPENDENT  VARIABLE,  I.E.  TIME 
RADIUS  OF  CLOUD 

CLOUD  TEMPERATURE  MINUS  SURROUNDING  TEMPERATURE 
VERTICAL  VELOCITY  OF  CLOUD 

X-COORDINATE  OF  CENTER  OF  MASS  FOR  THE  CLOUD 

Y-COORDINATE  OF  CENTER  OF  MASS  FOR  THE  CLOUD 

THE  HEIGHT  OF  THE  CLOUD  C.O.M, 

X-COORDIHATE  OF  TOP  OF  CLOUD 

Y-COORDINATE  OF  TOP  OF  CLOUD 


YP  AN  ARRAY  CONTAINING  COMPUTED  DERIVATIVES  OF  THE  DEPENDENT 
VARIABLES  WITH  RESPECT  TO  THE  INDEPENDENT  VARIABLE. 


REQUIRED  FUNCTIONS 


TEMP 


WIN 


CALCULATES  AMBIENT  ATMOSPHERIC  TEMPERATURE  AND  THE 
TEMPERATURE  GRADIENT  AT  CLOUD  HEIGHT. 


CALCULATES  THE  WIND 
CLOUD  HEIGHT, 


SPEED  IN  THE  X  AND  Y  DIRECTION  AT 


DIFFUS  COMPUTES  THE  DIFFUSIVITY  AT  A  SPECIFIED  HEIGHT. 
CALLED  BY  RKM 

m  Ki  »|i  4i  4t  4i  3|(  ift  ift  41  9|i  ^  in  *  41  %  >fi  41 4i  1ft  4i  in  41 4t  i|t  %  4i  Hi  If  i«t  4c  *li  Hi  % 

IF<T.LT. TBURST >G0  TO  200 

IF<Y<6>.GT.ZSTAR)G0  TO  5 
CALL  TEMP<Y<6>,TA,DTAD2) 

GO  TO  6 

5  TA»TC1+TC24.Y<6>+TC34iY<6)*4.2 
DTADZ-TC2+2  .  >»TC34iY<  6  ) 

6  CALL  WIN< Y<6>,XWCM,VWCM> 

T0P-Y<6)+Y<  1  > 

CALL  WIN<TOP,XWTOP,YWTOP> 


DFQ001 70 
DFGOOtSO 
DFQOOl 90 
DFQ00200 
DFQODSi 0 
DFG00220 
DFQ 00230 
DFQ00240 
DFQ002o0 
DFQ00260 
DFQ00270 
DFQ00280 
DFQ00290 
DFQ00300 
DFQ0031 0 
DFQ 00320 
DFQ00330 
DFQ 00340 
DFQ00350 
DFQ00360 
DFQ00370 
DFQ00360 
DFQ00390 
DFQ00400 
DFQ004i 0 
DFQ00420 
DFQ00430 
DFQ 00440 
DFQ00450 
DFQ00460 
DFQ00470 
DFQ00480 
DFQ00490 
DFQ00500 
DFQ0051 0 
DFQ00520 
DFQ00530 
DFQ00540 
DFQ00550 
DFQ00560 
DFQ00570 
DFQ 00580 
DFQ00590 
DFQ00600 
DFQ0061 0 
DFQ00620 
DFQ00630 
DFQ00640 
DFQ00650 
OFQ00660 
DFQ00670 
DFQ00680 
DFQ 00690 
DFQ00700 
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noo  non  oonoooooo 


TD1F=TA-T0 

TA 

DTAD2 

XWCM 

YXCM 

XUTOP 

YWTOP 

TR 

TR=Y<2  VTA 


DFQu071 0 
DFQ00720 

THE  AMBIENT  ATMOSPHERIC  TEMPERATURE  AT  CLOUD  HEIGHT  DFQCi0730 

THE  TEMPERATURE  GRADIENT  AT  CLOUD  HEIGHT  DFQ00740 

THE  UIND  SPEED  IN  THE  X  DIRECTION  AT  CLOUD  C.O.M.  DFQ00750 

THE  WIND  SPEED  IN  THE  Y  DIRECTION  AT  CLOUD  C.O.M,  DFQ00760 

THE  WIND  SPEED  IN  THE  X  DIRECTION  AT  THE  TOP  OF  THE  CLOUDFQ00770 

THE  WIND  SPEED  IN  THE  Y  DIRECTION  AT  THE  TOP  OF  THE  CLOUDFC00780 

THE  RATIO  OF  CLOUD  TEMPERATURE  TO  AMBIENT  TEMPERATURE  DFQ00790 

DFQ00800 
DFQ00S1 0 
DFC(0OS2O 

CALCULATE  ARVOL,  THE  SURFACE  AREA  TO  VOLUME  RATIO  DFSOOSSO 

DFQ00840 

ARV0L=3,/‘Y<1>  uFuOOSSO 

DFQOOdSO 

DEFINITION  OF  DIFFERENTIAL  EQUATIONS  DFQ00S70 

DFQ008&0 

YP<  1  ■j=ALPHAk>ABS<  Y<  3  ;  )  DFQ008S0 

ZZ1=Y<6)  ,  ^  DFQ00900 

KM=DIFFUS<20,2L,22O  DFQOOSiO 

GROWTH»KM/'Y<  1  )  DFQ00920 

IF<YP< 1 ).LT. GROWTH >YP< 1 >=GROWTH  DFQ00930 

YP<2>=-< 1 .♦TR>*ARV0L»Y<2>*YP< 1 >-Y< 3 >♦< DTAD2 >  DFQ00940 

YP<3)=9.8*TR-1  .4*ARV0L>»Y<3>'*VP<1  >  DFQ0  0950 

IF<Y<  1  )+Y<6>.GT.ZINV)YP<3)=0.  0  DFQ00960 

YP<4)=XWCM  DFQ00970 

YP<5>=YUCM  DFQ 00980 

YP<b)=Y<3>  DFQ00990 

IF<Y<  1  )+Y<6>.GT.ZINV)YP<6)«0.  0  DFQOl  000 

YP<7>=XUT0P  DFQOiOlO 

VP<.8)=YWT0P  DFQ  Of  020 

GO  TO  999  DFQ0f030 

200  CONTINUE  DFQOl 040 

DO  21 0  1=1 ,N  DFQOl 050 

YP<1)=0,  DFQOl 060 

2i0  CONTINUE  DFQOiOZO 

YP<3)=ACCEL  DFQOl 080 

YP<6)=Y<3>  DFQ0t090 

999  RETURN  DFQOl 100 

END  DFQOl 110 
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FUMCTION  OIFFUS<ZO,ZL,Z> 

COHMON/STARS/USTAR , TSTAR , ZSTAR 
COMMONXCOEF/AW , CU , BW , OU , AT , CT , BT , DT 

If  *  1*  « Ik Hi  iliiti  4< i«i  *  X<  K  <*% >k  K  >•>1* >4<  4<  ■*  W  4i 411* « I* 4i4i H<  ^  I' O >11  *41  >l> 4<  «> 

PURPOSE 

TO  CALCULATE  THE  DIFFUSIVITY  AT  A  GIVEN  HEIGHT 
INPUTS 

ZO  FRICTION  HEIGHT  IN  METERS, 

ZL  MONIN  OBUKHOV  LENGTH  IN  METERS. 

2  HEIGHT  AT  WHICH  DIFFUSIVITV  IS  DESIRED. 

CALLED  BY  ATMCAL.  RISE  AND  DIFEO 
SUBROUTINES  AND  FUNCTIONS  NEEDED 
NONE 

!  4i  4*  3|ii|i  4c  }|i  4i  4i  41 4i  4*  4i  4i  4i  4i  41 4i  iliiti  4i  4i  4i  4i  41*  4t  111  4(  III  }|r  9ft  #  i|t  4t  4t  4r  4i  %  9<i  4i  4i  %  in 

zz=z 

IF<  Z . GT . ZSTAR  >Z-ZSTAR 
NEUTRAL  CASE 


IF<ABS<ZL).LT. 1 .E3)G0  TO  100 

DIFFUS»,44.USTAR4<2 

GO  TO  999 

IF<ZL.CT. 0. 0>CO  TO  200 


UNSTABLE  CASE 


S=Z.-'2L 

IF<S.LT.-2.  >G0  TO  1  1  0 

0IFFUS=,44.ABS<2L4.USTAR4.S4.<  1  .-16,*3)4.4c<  U/4.)> 

GO  TO  999 

110  DIFFUS«.44.A6S<2L*<3.2AW)4.<-1  .  4.S  )4.4.<  4 . 23 .  >>4.USTAR 
CO  TO  999 


STABLE  CASE 


200  S-ZZZL 
SOsZOZZL 

IF<S.GT. 1 .5>G0  TO  210 

DIFFUS».44iZL*USTAR4.ABS<  1  ./<  1  ./<S0+S>+7.  >> 
GO  TO  999 

21  0  DIFFUS=.44.ZL4iUSTAR4.ABS<  1  .ZBW) 

Z-Z2 

999  RETURN 
END 


DIF0001 0 
DIF00020 
DIF00030 
DIF00040 
DIF00050 
DIF00060 
DIFuOOZO 
DIF00080 
DIF0U090 
DIF001 00 
DIFoOl 1 0 
DIF00120 
OIF00130 
DIF00140 
DIFuOISO 
DIF00160 
DIFuOIZO 
DIF00180 
DIF00190 
DIF00200 
DIF0021 0 
DIF00220 
DIF00230 
DIF00240 
DIFu0250 
DIF00260 
DIF00270 
DIF00280 
DIF00290 
DIF00300 
DIFOOSI 0 
DIF00320 
•DIF00330 
OIF00340 
DIF00350 
DIF00360 
DIF00370 
DIF00380 
DIF00390 
DIF00400 
DIF0041 0 
DIF00420 
DIF00430 
DIF00440 
DIFC0450 
DIF00460 
DIF00470 
DIF00480 
DIF00490 
DIF00500 
DIFOOSI 0 
DIF00520 
DIF00530 
DIF00540 
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FUNCTION  DOTPRD<h,B) 

DIMENSION  A<2),B<2) 

DOTPRD  IS  THE  SCALER  PRODUCT  OF  A  AND 

DOTPRD=A<  1  )'*B<  1  )+A<  2  )»B<  2  > 

RETURN 

END 


DOTuOOl 0 
DOT00020 
DOT00030 

B  DOT00040 

DOT00050 
DOT 00 060 
DOT00070 
DOT 00 080 


OOO—  OOO  000000000000000000000000000000000000 


) 


FUNCTION  DTERPI<ND1H,XI ,XVAL,VAL,VMIN,UORK) 

■k  «  41 4t  m  *  *  « !*< « >•■  *  III «  4i  Ik  «  41  •  X<  «•  XI  *  Hi  I*  *  4i  %  *  *  *  4i  *  <t>  4iiti «  4<  4i  >ti  Di  *  4i »  *  «  «  %  4i  *  «  4i  * 

PURPOSE 

PERFORMS  HN  N-DIMENSIONAL  LINEAR  INTERPOLATION 


INPUT 


NDIM  -  THE  NUMBER  OF  DIMENSIONS.  <-  DONT  RECALCUALTE  WEIGHTS) 
XI  -  THE  POINT  IN  THE  HVPERSPACE  AT  WHICH  THE  INTERPOLATED 
VALUE  IS  DESIRED.  XI  MUST  BE  A  VECTOR  OF  ATLEAST  NDIM 
In  LENGTH 

XVAL  -  THE  COORDINATE  VALUES  AT  THE  CORNERS  OF  THE  HYPERCUBE. 

THE  VECTOR  MUST  BE  SET  UP  LIKE  A  TWO-DIMENSIONAL  ARRAY 
<2  X  NDIM),  WHERE  THE  FIRST  SUBSCRIPT  REFERS  TO  THE 
HYPERCUBE  COORDINATES  IN  THE  SECOND  SUBSCRIPTS 
DIRECTION. 

VAL  -  THE  FUNCTIONAL  VALUES  AT  THE  CORNERS  OF  THE  HYPERCUBE 
SURROUNDING  XI.  THIS  VECTOR  MUST  BE  FILLED  EQUIVALENT 
TO  AN  NDIM  ARRAY  WITH  EACH  DIMENSION  AS  2.  THE  SIZE 
OF  VAL  SHOULD  BE  ATLEAST  2x.xiNDIM. 

VMIN  -  A  MINIMUM  VALUE  OF  VAL  FOR  WHICH  THE  INTERPOLATION 
WILL  USE  A  CORNER  VALUE. 

WORK  -  A  WORK  VECTOR  OF  ATLEAST  NDIMx.2.  USE  TO  STORE  COOR¬ 
DINATE  WEIGHTS. 

OUTPUT 

RETURNS  INTERPOLATED  VALUE  OF  VAL  AT  XI 
CALLED  BY  MOMENT 

41  Xi  41 4i  4i  4i  4. 4i  XI  Xi  4>  Xi  XI XI  Xi  Xi  Ik  «  41 XI 41  ♦  XI  4i  *  Xi  Xi  4i  XI XI XI  X<  Ik  XI XI  Xi  XI 41 XI  X<  Xi  4i  XI  Xi  XI XI XI  Xi  XI  4i  X<  XI  X>  XI  Xi  Xi  X>  Xi  Xi  Xi  Xi  Xi  Xi 

DIMENSION  XI<4),XVAL<8),  VAL<  l6),W0RK<e) 

SET  UP  THE  COORDINATE  WEIGHTS 

NDI=IABS<NDIM> 

IF<NDIM  .LT.  0)  GO  TO  1 
DO  100  1=1, NDI 
I2=lxi2 
11=12-1 

WORK<  I2)=<XI<  I  >-XVAL<  It  )  )/»<  XVAL<  I2>-XVAL<  II  )) 

WORK< II  )=1 .  -  WORK< 12) 

)0  CONTINUE 

INTERPOLATE  -  USE  BINARY  COUNTER  FOR  COORDINATE  LOCATION 

DTERPI*0. 

SUM=0. 

ND=2x.xiNDI 
DO  201  1-1 ,ND 

IF<VAL<1)  .LT,  VMIN)  GO  TO  201 

L-I-1 

WEIGHT-1 . 

DO  200  J-1 ,NDI 
N«M0D<L,2)  +  J*2  -  1 
UEIGHT-WEIGHT>kUORK(  N  > 

L=LK2 

)0  CONTINUE 

SUM-SUM  ♦  WEIGHT 
DTERPI-DTERPI  ♦  WEIGHTxiVAL<  I  ) 

)1  CONTINUE 

IF<SUM  ,EQ.  0. )  GO  TO  202 

DTERPI-DTERPI/SUM 

RETURN 


DTI0001 0 
DTI00020 
DTI00030 
DTI00040 
DTI00050 
DTI00060 
DTI0007U 
DTI uOOSO 
DTI  0  0090 
DTI001 00 
DTI  001 1 0 
DTI00120 
DTIOOfSO 
DTI00140 
DTI  00150 
DTI00160 
DTI00170 
DTI  00180 
DT100190 
DTI  0  0200 
DTI  0021  0 
DTI00220 
DTI  00230 
DTI  00240 
DTI  00250 
DTI00260 
DTI00270 
DTI002dO 
DTI00290 
DTI00300 
DTI  0031 0 
DTI  00320 
DTI00330 
DTI00340 
DTI00350 
DTI  00360 
DT100370 
DTI00380 
DTI  00390 
DTI00400 
DTI0041 0 
DTI  0  0420 
DTI00430 
DTI00440 
DTI00450 
DTI00460 
DTI00470 
DTI00480 
DTI00490 
DTI00500 
DTI0051 0 
DTI00520 
DTI00530 
DTI00540 
DTI00550 
DTI00560 
DTI00570 
DTI00580 
DTI00590 
DTI00600 
DTI0061 0 
DTI00620 
DTI00630 
DTI00640 
DTI00650 
DTI00660 
DTI00670 
DTI00680 
DTI00690 
DT100700 
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202  STOP 
END 


DTI007t  0 


DTI00720 


DTI00730 


( 
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o  oon  n  o  r  •  r»r.»  o  r»  o  r  -  r.i  r*  r*  o  o  ri  r  i  r  •  o  o  r  •  r » o  r*o  n 


subroutine  oterps< ii,x, val,nz> 

01  MENS  ION  X<81 ,4,3>,VAL<  16),II<4> 


purpose 

TO  SET  UP  A  ONE  DIMENSIONAL  ARRAY  OF  THE  VALUES  CORRESPONDING 
TO  THE  CORNERS  OF  THE  CUBE  WITHIN  A  TABULATED  ARRAY  WITH 
LOWEST  CORNER  INDICES  GIVEN 


INPUT 

II 

X 


SINGLY  DIMENSIONED  ARRAY  CONTAINING  THE  INDICES  OF  THE 
LOWES  I  CORNER  OF  THE  CUBE 

A  TRIPLY  DIMENSIONED  ARRAY  CONTAINING  THE  TABULATED 
VALUES  TO  BE  SET  UP.  THE  FIRST  INDE.Y  IS  THE  COLLAPSED 
INDEX  FOR  THE  FIRST  TWO  INDICES  OF  A  FOUR-DIMENSIONAL 
p  ^  y 

THE  RANGE  OF  THE  FIRST  INDEX  OF  THE  FOUR-DIMENSIONAL 
ARRAY 


OUTPUT 

VAL 


SINGLY  DIMENSIONED  ARRAY  CONTAINING  THE  VALUES  OF  X 
FOR  THE  16  CORNER  POINTS  OF  THE  CUBE 


CALLED  BY  MOMENT 


}|c  S4(  4i  ^  ^  *  IK  ^  *  IK  «  4i  ^  ♦  >4i  ♦  ilt  ♦ 

M=0 

DO  1 04  L=1 ,2 

LX=L  +  Il<4)  -  1 

DO  1 03  K=1 ,2 

KX*K  +  II<3)  -  1 

DO  102  JI=1,2 

JIX=<  J1  +  II<2)  -  2)>fN2 

DO  101  IJ=1,2 

I JX=JIX  +  IJ  +  II< 1  )  -1 

M=M+1 

VAL<M)=X< I JX,KX,LX) 

101  CONTINUE 

102  CONTINUE 

103  CONTINUE 

104  CONTINUE 
RETURN 
END 


DTSOOOf  0 
DTS00020 
DTS00030 
DTS00040 
DTSuOOSO 
DTS00060 
DTS00070 
DTS00080 
DTS00090 
DTS001 00 
DTS001 1 0 
DT600120 
DTS001 30 
DTS00140 
DTSO  0 1  DO 
DTS00160 
DTS00170 
DTS00180 
DTS001 90 
DTS00200 
DTS0021 0 
DTS00220 
DT500230 
DTS00240 
DTSu0250 
DTS00260 
DTS00270 
DTSU0280 
DTS00290 
DTS00300 
DTS0031 0 
DTS00320 
DTS00330 
DTS00340 
DTS00350 
DTS00360 
DTS00370 
DTS00380 
DTS00390 
DTS00400 
DT30041 0 
DTS00420 
DTS00430 
DTS00440 
DTS00450 
DT300460 
DTS00470 
DTS00460 


160 


00000000000000000000000000000000000000 


SUBROUTINE  DUSTCL<  NEWRTM, NRTHOS, ZTHP, THPHES, 2WN0, WNOMES, PHI ,  DUSOOOt  0 

1  THUND,NEUSRC,CHUT,NCHRG,DETDEP<NSOIL,DSOO<  DUS00020 

2  LOSTRN^TRNCOR,RECCOR,EDGE.OeSCOR,SPCHT,NEUTlM,  DU800030 

3  TIME, TRNLOS , CHTRO , HE  I GHT , CENWTH , SPCWTH , NCPTS , CRTS , NERR ,  DUS  00040 

4  NCHS,SRCBAS,SIDE1 ,S1DE2,6hDT)  DUSOOOSO 

LOGICAL  NEWATn,NEWSRC,L08TRN, EDGE, NEUTIM,HORIZ, ERR  DUS00060 

LOGICAL  SWITCH, CHANGE, DHDT  DUS00070 

DIMENSION  ZTMP<  2  > , TMPMES<  2  > , 2UND<  2  > , WNDMES( 2  > , TRNCORC  3  >  DUSO 0030 

1  , RECCOR<  3  > , CPTS<  2 , 6  > , OR I G<  2  > , TRNFRM<  2 , 2  > , TRN<  3  > , REC<  3 )  DUS  0  0090 

2  ,CNTRD<2>,0BSC0R<2>,DIR<2>  DUS00100 

3  ,SRCBAS<2>,SIDE1<2),SIDE2<2>,TEMP<2>,NCHSi;2>  DUSOOIIO 

REAL  KZ,KX  DUS00120 

COMMON  /'GE0M/'C0STH2,SINTH,SINTH2,V1SEXT,RTPI,SCRN<2>  DUS00130 

COMMON  /MODE,'  HORIZ  DUS00140 

COMMON  /uINDPRM/  DX20, DVXO, DZO, UO, UM, DN,  2INV  DUSuOiSO 

COMMON  /CLOCK/  FTIME,TWIND  DUS00160 

C0MM0N/M05/D I FF<  2 , 2  0  0  ) , NCHTOT , PRSEPt  2  0  0  > , HTOT , NARV , I  TOT ,  DUS  0  017  0 

+  COOR<2,200>,TSTAG<200>,DNMY<401 >  DUS00180 

COMMON  /ARRAY/OVRLAP, AREA,PER1M,PR4ARV,CENDIF  DUS00190 

COMMON  /lOUNlT/IOIN, lOOUT, IPHFUN, LOONIT, NDIRTU , NCHMT , KSTOR , NPLOTUDUS00200 


C0MM0N/CARB/RCARB1 ,RCARB2 
COMMON/ACL/CU I NDS , CW I NDC , CW I NOW 

COMMON/TRAN/VTR , K2 , KX , TTR , XTR , 2TR , QPUFF<  3  > , SWITCH , CHANGE 
COMMON  /CONST/P I , P 12 , PIRAD , TWOPI , TORRMB, COEGK 
DATA  0NEM/-1 ./ 

«  «  m  *  *  «  *  Id  * *  Hi  4<  *  Di  4>  4i  «<  *  *  *  I*  *  Hi  4,  *  *  4<  «•  *  >•<  4i «  •  Kl  4i  «i  *  •  *  li  *  *  4l  *  «  4i  •  4i  *  <<■ ,»  41 W  <*  ■* 

PURPOSE 

DUSTCL  CALCULATES  DUST  CLOUD  DIMENSIONS  AND  TRANSHITTANCES 
THROUGH  DUST  CLOUDS  FOR  GIVEN  METEOROLOGICAL  DATA,  SOIL  TYPE, 
EXPLOSIVE  CHARACTERISTICS,  AMO  WAVELENGTH. 

SEE  COMMENTS  IN  DRTRAN  FOR  DETAILS. 

SUBROUTINES  CALLED 


ATMCAL 


SOURCE 


SETUP 


RISE 


CLDIM 


TRNCAL 


ACCEPTS  METEOROLOGICAL  DATA  AS  ARGUMENTS  AND  COMPUTES 
NECESSARY  PARAMETERS  IN  COMMON  /WNDPRM/,  /EKWIND/ 
/EKTEMP,  /STARS/ 


DUS0021 0 
DUS00220 
DUS00230 
DUS00240 
DUS00250 
DUS00260 
DUS D 0270 
DUS00280 
DUS00290 
DUS00300 
DUS0031 0 
DUS00320 
DUS00330 
DUS00340 
DUS00350 
DUS00360 
DUS00370 
DUS 00380 
DUS00390 
DUS00400 
DUS0041 0 
DUS00420 
DUS00430 


ACCEPTS  SOIL,  CHARGE,  AND  WAVELENGTH  SPECIFICATIONS 
AS  INPUT  AND  COMPUTES  NECESSARY  PARAMETERS  AND  INITIAL  DUS00440 
VALUES  IN  COMMON  /PRTINF/  ,  /BUOYCL/  AND  /CARB/  DUS00450 

DUS00460 
DUS00470 
DUS 00480 
DUS00490 
DUS00500 
DUS0051 0 
DUS00520 
DUS 00530 
DUS 00540 
DUS 00550 
DUS 00560 
DUS 00570 
DUS 00580 
DUS00590 
DUS 006 00 

CONTROLING  ROUTINE  FO  THE  CALCULATION  OF  TRAHMITTANCES.DUSOOSt 0 

DUS 00620 


ACCEPTS  THE  USER  DEFINED  COORDINATES  OF  THE  CHARGES 
AND  CONVERTS  THEM  TO  THE  INTERNAL  < LOCAL >  CORRDINATE 
SYSTEM.  ALSO  COMPUTES  THE  AREA  AND  PERIMETER  OF  THE 
BOUNDING  PARALLELOGRAM  AND  OVERLAP  DISTANCE  OF  THE 
CHARGES  AND  RETURNS  THEM  IN  COMMON  /ARRAY/  AND 
/SEPRTN/. 

GIVEN  CLOUD  DIMENSIONS  DURING  BUOYANT  RISE  DEVELOPMENT 
OF  CLOUD,  RISE  CALCULATES  THE  DIMENSIONS  AT  A  LATER 
TIME 

DETERMINES  THE  OUTPUT  VARIABLES  DESCRIBING  THE  CLOUD 
DIMENSIONS. 


IF<LOSTRN.OR.EDGE>CO  TO  101 
HERR-4 
CO  TO  999 

101  IF< .NOT.HEWATM)  CO  TO  200 
THETAX-THWND4>PIRAD 

CALL  ATMCAL< NATMOS, 2TMP, TMPMES, ZWND, WNDMES, PHI , THETAX, DHDT , ERR > 
99999  IF< .NOT.ERR>GO  TO  155 


DUS00630 
DUS00640 
DUS 00650 
DUS 00660 
DUS00670 
5US00680 
DUS 00690 
DUS00700 


oooooo  oooo  oooo  onooo 


NERR-7 
CO  TO  999 
155  CONTINUE 

COMPUTE  THE  ROTATION  TRANSFORMATION  MATRIX  TO  CONVERT  USER 
DEFINED  COORDINATES  INTO  LOCAL  COORDINATES  UITH  X  AXIS  IN 
THE  WIND  DIRECTION. 

THETAX-THWND^PIRAD 
TRNFRM< 1 , 1 >-COS<  THETAX  > 

TRNFRM<  2 , 2 )=TRNFRM< 1 , 1 > 

TRNFRMt 1 , 2  >*S1N<  THETAX ) 

TRNFRM<  2,  1  >— TRNFRM<  t  ,  2  > 

200  CONTINUE 

IF< .NOT.NEUSRC)  GO  TO  300 
TWIND»1 .E5 
TTR»1 .E5 
TPRES=0. 

DELS. 001 
DO  250  1=1,2 

IFCHARY.GT. 1 >SRCBAS< I )«COOR< I, 1 ) 

ORIG< I>»SRCBAS<I> 

250  CONTINUE 

CALL  SOURCE<  CHWT , NCHRC , DETDEP , NSOIL , DSOD  > 

CALL  SETUP<NCHS,SRCBAS,SIDEt ,SI0E2,TRNFRM> 

300  CONTINUE 

IF< .NOT.LOSTRN)  GO  TO  400 

CONVERT  TRHCOR  AND  RECCOR  TO  LOCAL  COORDINATES  UITH  ORIGIN  AT 
SRCBAS  AND  X  AXIS  IN  UIND  DIRECTION, 

TRN<3)=TRNC0R<3) 

REC<3>-RECC0R<3> 

00  320  1=1,2 
TRN< 1 >=0. 

REC< I  )»0. 

DO  310  4*1,2 

TRN< I  )*TRN< I  )+TRNFRM< I , J )*<  TRHCOR<  J )-ORIG<  J  > > 

REC< 1  )»REC< I  )+TRNFRM< I , J )*<  RECCOR<  4 )-ORlG<  0  > > 

310  CONTINUE 
320  CONTINUE 
400  CONTINUE 

IF< .NOT. EDGE)  GO  TO  500 

COMPUTE  A  UNIT  VECTOR  IN  THE  DIRECTION  OF  THE  OBSERVERS  LINE 
OF  SIGHT  AND  A  UNIT  VECTOR  PERPENDICULAR  TO  THE  LINE  OF  SIGHT 

CALL  VSUM<ORIC,OBSCOR,ONEM,DIR> 

CALL  UNITCDIR, DIR, RANGE) 

COSTH»0, 

3INTH=0. 

DO  410  4*1,2 

COSTH-COSTH+TRNFRM< 1 , J )*DIR<  4 ) 

SIHTH=SINTH+TRNFRM<2, J)*DIR<  4) 

410  CONTINUE 

SINTH2*SINTH*SINTH 
C0STH2-C0STH**2 
8CRN< 1 >-SINTH 
SCRN<2>»-C0STH 

COMPUTE  THE  PR04ECTI0N  OF  EACH  DIFFERENCE  VECTOR  DIFF  ONTO  THE 
VECTOR  PERPENDICULAR  TO  THE  LINE  OF  SIGHT, <DIFF< 1 , 4>,DIFF(2, 4>> 
IS  THE  VECTOR  FROM  THE  REFERENCE  CHARGE  TO  THE  4TH  CHARGE 
LOCATION  IN  THE  INTERNAL  COORDINATE  SYSTEM. 

PARY1-0. 0 

PARY2-0.0 

DO  420  4-t,NCHTOT 

DO  415  1-1,2 

TEMP<I>-01FF<I,4) 


DUS00710 
DUS00720 
DUS00730 
DUS00740 
DUS 00750 
DUS00760 
DUS00770 
DUS00780 
DUS00790 
DUS00800 
DUS0081 0 
DUS00820 
DUS00830 
DUS00840 
DUS00d50 
DUS00860 
DUS00870 
DUS00880 
DUS00S90 
DUS 009 00 
DUS0091 0 
DUS 00920 
DUS 00930 
DUS00940 
DUS009S0 
DUS 00960 
DUS00970 
DUS00980 
DUS00990 
DUS01000 
DUS01010 
DUS 01 020 
DUS01 030 
DUS01 040 
DUS01 050 
DUS01 060 
DUS01 070 
DUS01 080 
DUSOl 090 
DUS011 00 
DUSOl 1 1 0 
DUSOl 120 
DUSOl 130 
DUSOl 140 
DUSOl 150 
DUSOl 160 
DUSOl 170 
DUSOl 180 
DUSOl 190 
DUS01200 
DUS0121 0 
DUS01220 
DUS01230 
DUS01240 
DUS01250 
DUS01260 
DUS01270 
DUS01280 
DUS01290 
DUS01300 
DUS0131 0 
DUS01320 
DUS0t330 
DUSOl 340 
DUS01350 
DUSOl 360 
DUS01370 
DUSOl 380 
DUS0t390 
DUS01400 
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415  CONTINUE 

PRSEP<  J>=00TPRD<TEMP,3CRN) 

X*PRSEP<  J> 

IF<X.LT. 0. 0>GO  TO  416 
IF<X.GT,PRRV1 >PARY1*X 
GO  TO  420 

416  IF<X.LT.PARY2)PARy2=X 
420  CONTINUE 

PR JARY-<  PhRY 1 -PhRY2 i/2 . 

CENDIF-<  PARYt  ■•■PARY2  >/2  . 

500  CONTINUE 

IF<NARY.EQ.3>G0  TO  600 

IFiNEUTIM)  CALL  RI3E< TPRES, TIME, DEL > 

600  IF< .NOT, EDGE)  GO  TO  650 
FTIME=TIME 

CALL  CLDIM<CNTRD,HEIGHT,CENUTH,SPCHT,8PCWTH,NCPTS,CPTS,ERR> 
1F<  .HOT.ERR>GO  TO  650 
NERR=^6 
GO  TO  999 
650  CONTINUE 

IF<  .NOT.LOSTRH>GO  TO  999 

CALL  TRNCAL<  TRN , REC . TIME , TRNLOS  > 

999  RETURN 
END 


DUS0141 0 
OUSCt420 
DUS01430 
DUS01440 
DUS014S0 
DUS01460 
DUS01470 
DUS0t480 
DU301490 
DUS01500 
DUS0151 0 
DUS01520 
DU301530 
DUS01540 
DUS01 550 
DUS 01 560 
DUS01570 
DUS015S0 
DUSOl 590 
DUS01600 
DUS0161 0 
DUS01620 
DUS01630 
DUS01640 
DU301650 
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FUMCTION  £RF<X) 

CALCULATES  THE  ERROR  FUHCTIOH 

INPUT 

X  VALUE  AT  WHICH  ERROR  FUNCTION  IS  DESIRED 
FUNCTIONS  AND  SUBROUTINES  NEEDED 
NONE 

Ik  4i  *  Ik  Ik  Ik  Ik  >t>  *  ak  *  *  4i  <k  iti  4i  *  4i  «•  >•<  4i  ■*  4>  4i  4i  «•  itiili  *  4i «  *  •  4i  1*  *1 4ii|i  Ik  *  Ik  >ti  »■  *  Ik  *  % 

DIMENSION  P<3,5),Q<3,5> 

DATA  RPl/. 5641 896/ 


DATA  P/2.138533E+01,7 
1 .722276E+00a6 
3. 166529E-01 ,3 
0.  ,5 


1  0 


20 


30 

40 


50 

60 


70 

80 

300 


.0.5)  1-1 
.4. >  1=3 
1 0i20,30 


373888E+  00 , -4 . 257996E-02 , 
865018E*00,-1 .96  0690E-01  , 
031799E-k00. -5. 1688238-02. 

.  631696E-01 . 0. 

0.  ,4.318779E-05, 0.  / 

DATA  Q/t .895226E+01 .7.373961E+00. 1 .509421E-01 . 

7.843746E+00. 1 .518491E+01 .9.214524E-01 , 

1 . OOOOOOE+00. 1 .279553E+01 > 1 . OOOOOOE+00. 
0.  .S.354217E400. 0. 

I-  0.  .  1  ,  OOOOOOE+00. 0.  / 

AX=ABS<X) 

ERFC=0, 0 

IFCAX.GT. 1 1 . 0)  GO  TO  300 
X2-AX-AX 
I  =2 

IF<AX.LT 
IF<AX.GT 
IF<  I-2> 

N-3 
2=X2 

GO  rO  40 
N=5 
2=AX 

GO  TO  40 
N=3 

2=1 ,/X2 
3P=P< I.N) 

SQ»Q< I.N) 

N1=N-1 

DO  50  K=1,Nf 
J=N-K 

SP=SP>k2+P<  I.  J> 

SQ=SQ*Z+Q< I , J ) 

IF< 1-2)  60.70.80 
ERFC=1  .  0-X>kSP/SQ 
ERF=1 i-ERFC 
RETURN 

ERFC=EXP< -X2 )*SP/SQ 
GO  TO  300 

ERFC=EXP<  -X2  )/AX>k<  RPI*SP/<  SQ*X2  )  > 

IF<X.LT.0.0)  ERFC-2. 0-ERFC 
ERF=1 i-ERFC 
RETURN 
END 


ERF00120 
ERF0001 0 
ERF 00 020 
ERF 00 030 
ERF00040 
ERF 00 050 
ERF 00 060 
ERF00070 
ERFOOOdO 
ERF00090 
ERFOOl 00 

ik4iikikikik«ikik->k>kik>k>ktt4>ikERF  0  0  1  1  0 
ERF00130 
ERF00140 
ERF00150 
ERF00160 
ERF00170 
ERF00180 
ERF00190 
ERF00200 
ERF  0  021  0 
ERF00220 
ERF00230 
ERF00240 
ERF00250 
ERF00260 
ERF00270 
ERF00260 
ERF00290 
ERF00300 
ERF0031 0 
ERF 00320 
ERF00330 
ERF00340 
ERF  00350 
ERF  00360 
ERF  00370 
ERF00380 
ERF00390 
ERF  004 00 
ERF0041 0 
ERF00420 
ERF00430 
ERF00440 
ERF00450 
ERF00460 
ERF00470 
ERF00480 
ERF00490 
ERF00500 
ERF00510 
ERF00520 
ERF 00530 
ERF 00540 
ERF 00550 
ERF 00560 
ERF00570 
ERF  00580 
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SUBROUTINE  FIT< X, F, A, B, C  i 

QUADRATIC  FIT  TO  THREE  POINTS  USING  NEWTON'S  FUNDAMENTAL  FORMULA 
INPUTS 

X  -  3  VALUES  OF  THE  INDEPENDENT  VARIIABLE 
F  -  3  FUNCTION  VALUES  CORRESPOND! ING  TO  THE  X  VALUES 
OUTPUTS 

A  -  COEFFICIENT  OF  THE  TERM 

B  -  COEFFICIENT  OF  THE  X  TERM 

C  -  CONSTANT  TERM 

DIMENSION  X<3i,F<3i 
H=X<  2  >-X< 1 ) 

DF1=»<F<2>-F<  1  i)XH 

DF2=<  F<:  3  i-2  .  •F<  2  >+F<  1  >  >/(.  2  .  *H**2  ) 

A=DF2 

B=DF1-DF2>»<:X<2)-*-X<  1  >i 
C=F<  1  >+X<  1  )>*<  X<  2  )»DF2-DF  1  ) 

RETURN 

END 


FITOOISO 
FITOOOl 0 
F1T00020 
FIT00030 
FIT0(>040 
FIT00050 
FIT00060 
FIT000?0 
FIT00080 
FIT00090 
FITuOlOO 
FIT001 1 0 
FIT00120 
FIT00130 
FIToOl 40 
FITOOfSO 
FIT00160 
FITOOf 70 
FITOOiSO 
FIT00200 
F1T0021 0 
FIT00220 
FIT00230 
FIT00240 
FIT00250 
FIT00260 
FIT00270 


FITu02e0 
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FUNCTION  FUNCT<X,2> 

LOGICAL  HORIZ.SKIP 
COHMON  /CLOCK/  TIME,TUIND 
COMMON/MODE/HOR I Z 
COMMON/SKIPIT/SKIP 

III  I#  >1*  111  41 4*  4i  4i  %  4i  %  *li  ifi  111  i4i  4i  Ik  %  III  *  4i  *  «  111  iHi*  111  *  41 4i  4i  4i  41 


PURPOSE 


TO  SUPPLY  A  TRANSMITTANCE  FUNCTION  FOR  THE  CONTOUR  TRACING 
ROUTINE  IN  ORDER  TO  DETERMINE  THE  CLOUD  EDGE. 


INPUT 


THE  HORIZONTAL  COORDINATE  IN  METERS 
THE  VERTICAL  COORDINATE  IN  METERS 


OUTPUT 

RETURNS  THE  LOG  OF  THE  OPTICALLY  WEIGHTED  CL  VALUE  <AT 
VISIBLE  WAVELENGTHS)  FOR  THE  LINE  OF  SIGHT  SPECIFIED  BY  X,2 

FUNCTIONS  CALLED 

CWINO 

CALLED  BY  GFUN.  CLIMB.  GRAD2 

« III  *  >•>  >l»l<  >)■  Hull  >l<  Hi  41  no*  »•  Kc «  *  m  I*  I*  W  Ik  I*  lt>  *  O  >t<  4»»  If  *  1*  Hi  «  *  %  1* 

HORI2=.TRUE. 

SKIP=.TRUE. 

Y=0. 

EXT1»0,0 

EXT2=0.0 

IF<Z.LE. 0. )GO  TO  1 00 
EXT1s=CWIND<X.Y.2.TlME) 

IF<TIME.LE.TWINO)GO  TO  10 
EXT2=CSPHER<X, Y,2,TIME) 

1 0  EXT=EXT1+EXT2 

IF<EXT .LE. i .E-30>GO  TO  100 
FUNCT=ALOG<EXT> 

GO  TO  999 
100  FUNCT=-30, 

999  CONTINUE 
RETURN 
END 


FUC0001 0 
FUC00020 
FUC00030 
FUC00040 
FUCOuOSO 
FUC00060 
FUC00070 
FUC00080 
FUC0OO9O 
FUC001 00 
FUC001 1 0 
FUC00I20 
FUCOOi 30 
FUC00140 
FUCOOtSO 
FUC00160 
FUC00170 
FUC00180 
FUC00190 
FUC00200 
FUC0021 0 
FUC00220 
FUC00230 
FUC 00240 
FUC 00250 
FUC00260 
FUC00270 
FUC 00280 
FUC00290 
FUC00300 
FUC00310 
FUC00320 
FUC0G330 
FUC00340 
FUC 00350 
FUC 00360 
FUC00370 
FUC00380 
FUC00390 
FUC00400 
FUC0041 0 
FUC00420 
FUC00430 
FUC00440 
FUC00450 
FUC00460 
FUC 00470 
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SUBROUTINE  GAMMAi XX, GX, lER ) 
SUBROUTINE  GpNHi!| 


PURPOSE 

COMPUTES  THE  GRMMP  FUNCTION  FOR  A  GIVEN  ARGUMENT 
USAGE 

CALL  GAMMA<XX,GX, 1ER> 

DESCRIPTION  OF  PARAMETERS 

XX  -THE  ARGUMENT  FOR  THE  GAMMA  FUNCTION 
GX  -THE  RESULTANT  GAMMA  FUNCTION 
lER  -THE  RESULTANT  ERROR  CODE  WHERE 
lERaO  NO  ERROR 

IER=i  XX  IS  WITHIN  .000001  OF  BEING  A  NEGATIVE  INTEGER 
IER-2  XX  GT  57,  OVERFLOW,  GX  SET  TO  1 .E32 

COMMENTS 

NONE 

SUBROUTINES  AND  FUNCTIONS 
NONE 

METHOD 

THE  RECURSION  RLATION  AND  POLYNOMIAL  APPROXIMATION 

BY  C.  HASTINGS, JR. ,  'APPROXIMATIONS  FOR  DIGITAL  COMPUTERS', 

PRINCETON  UNIVERSITY  PRESS,  1955 


IF<XX-57. >  6,6,4 
4  IER=2 
GX=1 .E32 
RETURN 
6  X=XX 

ERR=1 , OE-6 
IER-0 
CX=1 . 0 

IF<X-2.0>  50,50,15 
10  IF<X-2.0>  110,110,15 
15  X=X-1 , 0 
GX=GX-t‘X 
GO  TO  10 

50  IF<X-1 ,0)  60, 120, 1 1 0 

SEE  IF  X  IS  NEAR  NEGATIVE  INTEGER  OR  ZERO 

60  IF<X-ERR>  62,62,80 
62  Y«FLOAT< INT<X)>-X 

IF<ABS<Y)-ERR>  130,130,70 

X  NOT  NEAR  A  NEGATIVE  INTEGER  OR  ZERO 

70  IF<X-1 .0)80,80,110 
80  GX^GX/X 
X=X*1 . 0 
CO  TO  70 
110  Y=X-1 .0 

GV=l  ,  0+Y*<- 0.5771  017+Y*<  0.985854 0+V*< -0.87642 18+ Y'*^-  0.83282 1 2+ 
1 -0 . 5684729+V*<  0 , 2548205+Y*< -0 . 05149930) )>>))) 

CX»=GX*GV 
120  RETURN 
130  IER-1 
RETURN 
END 


GAH0031 0 
GAM0001 0 
GAM00020 
GAM00030 
GAH00040 
GAM00050 
GAMG0060 
GAM00070 
GAM00080 
GAM00090 
CAM001 00 
CAMOOI 1 0 
GAMC0120 
GAM00130 
CAM00140 
GAM00150 
GAM00160 
GAM00170 
GAMuOIBO 
GAMC0190 
GAM 002 00 
GAM0021 0 
GAM 00220 
GAH00230 
GAH00240 
GAM00250 
GAM00260 
GAM00270 
GAM00280 
.GAM00290 
GAM00300 
CAM 00320 
GAM00330 
GAM00340 
GAM00350 
GAM00360 
GAM00370 
GAM00380 
GAM00390 
GAM00400 
GAM0041 0 
GAM00420 
CAN00430 
GAM00440 
GAH00450 
CAM004e0 
CAH00470 
GAM00480 
GAM00490 
CAM00500 
GAM0051 0 
CAM00520 
GAH00530 
GAM00540 
CAM 00550 
CAM 00560 
GAH0057G 
GAM 00580 
GAM00590 
CAM00600 
GAM0061 0 
GAM00620 
CAN00630 
GAM 00640 
GAH00650 
CAM 00660 


( 
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FUNCTION  CFUN<S> 

GFUN  IS  THE  RESTRICTION  OF  THE  TUO  DIMENSIONAL  FUNCTION,  F,  TO 
A  LINE.  I.E.  FORM  C<  S  >«F<  X,  Y  >,  WHERE  (  X,  Y  )«BASE+S-*DIR  ■ 

EXTERNAL  FUNCT 

DIMENSION  P<2> 

COHMON,'LINE/’BASE<  2  >,  DIR<  2  >,  OFDS/'SPECS/RES,  DELTA,  THETAN,  CON 
CALL  VSUM< BASE, DIR, S,P) 

GFUN«=FUNCT<P<  1  >,P<2)) 

RETURN 

END 


GFU00010 
CFU00020 
GFU00030 
CFU00040 
GFU00050 
GFU00060 
GFU00070 
GFUOOOBO 
GFU00090 
GFU001 00 
GFU001 1 0 
GFU0012D 


> 
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SUBROUTINE  GRAND< U, TR, XHORH, T IHE, TIVEH, VOIR, VALUE )  GR000320 

CROOOOI 0 

0  EVALUTE  THE  INTEGRAND  FOR  THE  TRAPEZOIDAL  INTEGRATION  GRD00020 
NC  THE  OPTICALLY  WEIGHTED  CONCENTRATION  ALONG  THE  LINE  OF  GRD00030 
RE  THE  DUST  IS  GENERATED  BY  A  VEHICLE.  GRD00040 

CRD00G50 
GRD00060 
GRD000?0 

-  A  UNIT  VECTOR  ALONG  THE  LINE  OF  SIGHT  GRDOOOSO 

CRD00090 

-  THE  COORDINATES  OF  THE  TRANSMITTER  IN  THE  LOCAL  COORDINATEGRD001 00 

SYSTEM  .  GRD00110 


ROUTINE  TO  EVALUTE  THE  INTEGRAND  FOR  THE  TRAPEZOIDAL  INTEGRATION 
FOR  FINDING  THE  OPTICALLY  WEIGHTED  CONCENTRATION  ALONG  THE  LINE  OF 
SIGHT  WHERE  THE  DUST  IS  GENERATED  SY  A  VEHICLE. 

INPUTS 

U  -  A  UNIT  VECTOR  ALONG  THE  LINE  OF  SIGHT 


XHORM  -  DISTANCE  BETWEEN  THE  TRANSMITTER  AND  RECEIVER 
TIME  -  PRESENT  TIME  AT  WHICH  A  TRANSMITTANCE  IS  WANTED 
TIVEN-  TIME  THAT  THE  VEHICLE  HAS  TRAVELED 

VDIR  -  VECTOR  CONTAINING  DESCRIBING  THE  VEHICLE  DIRECTION  AND 
SPEED 

OUPUT 

VALUE  -  VALUE  OF  THE  INTEGRAND 

FUNCTIONS  AND  SUBROUTINES  HEEDED 

CONLEN  -  TO  FIND  THE  LENGTH  OF  THE  INTERSECTION  OF  THE  LINE  OF 
SIGHT  AND  THE  TILTED  CYLINDER 

4i  *  I*  *41 41  <*  4i  iK  >«•  *<•■*■*  4i  <*  I**  1*  ■*■*41 f  I*  ««*>**  4> « >l>4i  *  4>  %**  «<**  4>  ■kOti  Ik  *<*■*<*<*>*>*  >l<  * 

DIMENSION  U<3>,TR<3>,VDIR<2>,VP<2> 

COMMON/MOS/DMMMY<  604 ), OMM<  600  >, 

+  ICOUNT,T1MES<25),XCO<3,25),XCU3,25>,RT<3,25), 

♦  R8C3,25),Z2<3,25) 


GRD001 1 0 
GRD00t2O 
CRD00130 
CRD00140 
GRD00150 
GRD0u160 
GRD00170 
GRDOOISO 
GRD00190 
GRD00200 
GRD002t  6 
GRD0022U 
GRD00230 
GRD00240 
GRD 00250 
GRD 00260 
CRD00270 
GRD00260 
CRD00290 
GRD00300 
CRD0031 0 
GRD00330 
GRD 00340 
CRD 00350 
CRD 00360 


r  O  i  /  J  W  vrM.' V  V 

COMMON  /'lOUHIT/'IOIN,  lOOUT,  1PHFUN,LOUH1T,NDIRTU,NCL1MT,KSTOR,NPLOTUCRD00370 


COMMON/VL/'VLOAD 

COMMON  /'CONST/'P  1 ,  P 1 2 , P IRAO ,  TWOPl , TORRMB ,  CDEGK 

FIND  THE  VEHICLE  POSITION  AT  TIME  TIVEN 

VP<  1  )=TIVEH>*VDIR<  1  ) 

VP<2>»TIVEH>*VDIR<2> 

TOF-TIME-TIVEH 
DO  10  I-1,ICOUNT 
1ND=I 

IF<T0F.LT.TIME8< I )>GO  TO  20 
10  CONTINUE 

IF  TOF  <TIME  OF  FLIGHT)  IS  GREATER  THAN  TABULATED  VALUES  IT  IS 
ASSUMED  THE  THE  CLOUD  HAS  DISSIPATED 

XC=»X1^*Z+X0  IS  THE  LINE  THRIUGH  THE  CENTER  OF  THE  CYLINDER 
GO  TO  50 

20  X0-T0F^*<XC0<  1  ,IHD)>*TOF+XCO<2,  IHD>>+XC0<3,  IHD> 

X1«T0F4.<  XC1<  1,  lHD)'*T0F*XCt<2,  IND)>+KC1<3,  IMD) 

RAO-TOF'*<  RT<  1 ,  IHD  )-*T0F*RT<  2, 1M0)>+RT<3,  IND) 

HTT0P«=T0F‘*<Z2<  1 ,  IHO  )*T0F*22<2, 1HD)>+Z2<3,  IMD> 

HTB0T»0. 0 

RTOP*RAD 

RBOT-RAD 

XCEM»VP<  1  )+<X1>»HTTOP+XO) 

YCEH«»VP<2) 

XB-VP<  1  >+<Xl4iHTBOT+XO) 

YB-VP<2> 

IF<U<3>.LT.1 .E-06)GO  TO  30 

COMPUTE  INTERSECTION  LENGTH  FOR  HOH  HORIZONTAL  LINES  OF  SIGHT 


GRD00380 
GRD00390 
GRD00400 
GRD0041 0 
GRD00420 
CRD00430 
GRD00440 
CRD 00450 
GRD00460 
GRD00470 
GRD00480 
GRD00490 

gRD00500 
RD00510 
GRD 00520 
GRD 00530 
GRD 00540 
GRD 00550 
GRD 00560 
GRD00570 
CRD 00580 
GRD 00590 
CRD00600 
GRD00610 
CRD 00620 
GRD00630 
GRD00640 
GRD00650 
GRD00660 
CRD 00670 
GRD 00680 
GRD00690 
CRD00700 
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Cf!»LL  CONLENcU,TR,HTTOP,HTBOT,XCEH.  VCEN,RTOP,RBOT,XB, 

GO  TO  40 

DETERMINE  LENGTH  OF  INTERSECTION  FOR  A  HORIZONTAL  LINE  OF  SIGHT 


30 


35 

40 


50 

■599 


IF<HTT0P.LT.TR<3)>G0  TO  35 
A=U<  1  )’»*2+U<  2  >**2 

B*U< 1 >*<  TR< 1  )-XCEN  >+U<  2  >♦<  TR<  2  >-YCEN  > 

TR<  I  >-XCEN  )i*ii2+<  TR<  2  i-YCEH  >f*2-RAD*i'2 
XkB'*<*2-A>kC 

IFtlX.LT.  0. 0>GO  TO  35 

P1«<-B+SQRT<X>>/'A 

P2-<-B-SQRT<X))/'A 

IF<  P 1 . GT . XNORM . AND . P2 . GT , XNORM  >CO  TO  35 
IF<P2.LT.0.0.AND.P1 .LT.O.O)GO  TO  35 
PLEN-AMIHUP1  ,XN0RM)-AMAX1<P2,  0. 0> 

GO  TO  40 
PLEN=0.0 

YOL=P  I  *HTT OP*<  RADf’J-Z  ') 

VALUE=VLOAD*PLEN/'VOL 

GO  TO  999 

VALUE=0. 0 

RETURN 

END 


YB, XNORM, PLEN)GRD007i  0 
GRD 00720 
GRD00730 
ORD00740 
GRD00750 
GRD 00760 
GRD00770 
GRD00780 
GRD00790 
GRD00800 
GRD0081 0 
GRD00d20 
GRD00830 
GRD00840 
GRD00850 
GRD00860 
GRD00e70 
GRDOOdSO 
GRD 00890 
GRD00900 
GRD0091 0 
CRD00920 
GRD00930 
GRD 00940 
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SUBROUTINE  GREENcZ.ZI , T , ALPHA , TO , lER  ) 

41 4i Hi 4iiti « Ik :«■  III itt % 4i * 4e K< Xi itc Ik >ti  Ik « Ik 4i Kii* 41  * <ti I* « 4> 41  «■  Hi 4< 4> H* 4ii|> 4i 4t » * 4i 41  If  4< O K< 

PURPOSE 

TO  COMPUTE  THE  GENERALIZED  GREENS  FUNCTION 
USES  GREENt 

SEE  GREEN1  FOR  ARGUMENT  LIST 


REAL  N,M 

COMMON  I'WNDPRM.'DXZOi  DYX0,DZ0iU0,M,NiZlNV 

IF<N  lEQ.  1 ■>  GO  TO  2 

X2=2.-N 

AT=ALPHA*T 

IF< AT  .GE.  21 )  RETURN 

CALL  GREEN1<c  2  +  AT  j4.4.X2,Z1'*"»X2|X2>t.X2fT,<N-l  .  )/X2,  T1 ,  lER  > 

T1»T1*X2*Zl4i4i<  1  .-N> 

U=1  , 

T2=0. 

IF<ABS< ALPHA)  .LT.  l.E-4)  GO  TO  1 

2M2*Z-21+AT 

X2-N+1 . 

AN1-ALPHA*X2 

2M2N=Z1**X2  -  <21-AT)>»*X2 
ARC»<  -AN  1  fZMZiiZMZ  )/■<  4  .  <»ZM2H  > 

IF<ARC  iLT.  -70.  )  GO  TO  3 

T2=SaRT<  AN  1 A  4 . *3 . f  4 1 5926*ZMZN > )*EXP<  ARC  > 

3  IF<T1 .LT, 1 .E-30  .AND.  T2 . LT . 1 . E-30 >  RETURN 

CALCULATION  OF  MIXING  RATIO,  U,  BY  N«1  ANALOGY 


CALL  GREENt<Z+AT,21 ,T, 0. ,TtU, IER> 

X2»>2, 

ANl«ALPHAfX2 

2MZN=21**X2  -  <21-AT)>**X2 
T2U=u. 

ARG»< -AN  1 ♦ZMZ^ZMZ  >/< 4 . ♦ZMZN ) 

IF<ARG  .LT .  -70.  )  GO  TO  4 

T2U«S0RT<  AN  1  /<  4  .  *3 . 1  4 1  5926*ZMZN  )  )>*EXP<  ARC  > 

4  1F<T1U,LT. 1 .E-30  .AND.  T2U . LT . 1 . E-30 >  GO  TO  1 
CALL  GREENKZ, 21  ,T, ALPHA, G,IER> 

U=<  G-T2U  )/< T 1 U-T2U ) 

1  IF<U  .LT.  0.  )  U=*0, 

IFCU  .GT.  1 .  )  U=1  , 


COMBINE  LIMITING  SOLUTIONS  WITH  DETERMINED  MIXING  RATIO 

T0=U>*T1  +  <  1  .-U>i>T2 
RETURN 

2  CALL  GREEN1<Z,Z1 ,T,ALPHA,T0, lER) 

RETURN 

END 


GRE0001 0 
CRE00020 
GRE0U030 
QRE00040 
GRE00050 
GRE00060 
GRE00070 
GREOOOSO 
GREOOOSO 
GRE001 00 
GREOCt  to 
GRE00120 
GRE00130 
GRE00t40 
GRE00150 
GREOOtSO 
GRE00170 
GRE00180 
CREODtSO 
GRE00200 
GR£002i 0 
GRE00220 
GRE00230 
CRE00240 
GRE00250 
GRE00260 
CRE00270 
GRE00280 
GRE00290 
GRE00300 
GRE003t0 
GRE00320 
GRE00330 
CRE00340 
CRE00350 
GRE00360 
GRE00370 
GRE00380 
CRE00390 
GRE00400 
GRE004I0 
CRE00420 
GRE0043G 
GRE00440 
GRE00450 
GRE00480 
CRE00470 
GRE00480 
GRE00490 
GRE00500 
CRE00510 
GRE 00520 
GRE00530 
GRE 00540 
GRE 00550 
GRE00560 
GRE00570 
GRE 00580 
GRE 00590 
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SUBROUTINE  GREENU  Z ,  21  ,  T, HU , BI ,  lER  > 


SUBROUTINE  GREEN1 


GRV004S0 
GRV0001 0 
GRV00020 

„  CRV00030 

PURPOSE  GRV00040 

COMPUTE  THE  I  BESSEL  FUNCTION  FOR  R  GIVEN  RRGUMENT  ANO  ORDER  GRV00050 
AND  MULTIPLY  BY  AN  APPROPRIATE  POWER  OF  THE  ARGUMENT  GRV00060 

AND  AN  EXPONENTIAL  IN  ORDER  TO  CALCULATE  THE  GREENS  - 

FUNCTION  FOR  THE  WIND  DIFFUSION  EQUATION 


USAGE 

CALL  GREENUZ^ZI  ,T,NU,BI,IER> 

DESCRIPTION  OF  PARAMETERS  ,  _ 

2,21,T  -THE  ARGUMENTS  OF  THE  FUNCTION  DEsIRED 
NU  -THE  ORDER  OF  THE  I  BESSEL  FUNCTION 
BI  -THE  RESULTANT  BESSEL  FUNCTION 
lER  -RESULTANT  ERROR  CODE  WHERE 

IER=-1  EXPONENTIAL  UNDERFLOW  <NON-FATAL>,  Bl  SET  TO 
IER-0  NO  ERROR 

IER-1  NU  NEAR  NEGATIVE  INTEGER 

IER-2  OVERFLOW  IN  GAMMA  ^  _  , 

IER=3  UNDERFLOW,  BI  .LT.  l.E-32,  BI  SET  TO  0 . 0 
1ER  =  '«  OVERFLOW,  X  .  GT  .  90  WHERE  X  .  GT .  N 
IER=5  X  IS  NEGATIVE 


0. 0  GR 


GRV00070 
GRV00080 
GRV00090 
GRVOOI 00 
GRV00110 
GRV00120 
GRV00130 
GRV00140 
GRV001S0 
GRVOOI SO 
CRV00170 
GRVOOiBO 
GRV00190 
GRV00200 
GRV0021 0 
GRV 00220 
GRV00230 
GRV00240 
GRV00250 
GRV002S0 
GRV 00270 
GRV002S0 


REMARKS 

NU  IS  A  REAL  NUMBER 

N  AND  X  MUST  BE  . GE .  ZERO  _ 

THIS  SUBROUTINE  IS  A  MODIFICATION  OF  BESI  WHICH  COMPUTES  THE  GRV00290 
1  BESSEL  FUNCTION  FOR  INTEGER  ORDERS.  THE  CHANGE  REQUIRES  CRV00300 
USE  OF  THE  GAMMA  FUNCTION  FOR  COMPUTING  THE  FIRST  TERM  OF  THECRV00310 
SERIES.  THE  SUCCESSIVE  TERMS  ARE  CALCULATED  WITH  THE  SAME  GRV00320 
RECURSION  FORMULA  AND  THE  ASYMPTOTIC  APPROXIMATION  IS  ALSO  CRV00330 
UNCHANGED.  BESI  IS  IN  THE  IBM  SYSTEM73S0  SCIENTIFIC  GRV00340 

SUBROUTINE  PACKAGE.  MODIFICATIONS  MADE  BY  D.  DVORE,  AERODYNEGRV00350 


RESEARCH  INC.  JANUARY  15,1979. 

SUBROUTINES  AND  FUNCTIONS  REQUIRED 

GAMMA  WHICH  COMPUTES  THE  GAMMA  FUNCTION 

METHOD 

COMPUTES  I  BESSEL  FUNCTION  USING  SERIES  OR  ASYMPTOTIC 
APPROXIMATION  DEPENDING  ON  THE  RANGE  OF  THE  ARGUMENT. 

CALLED  BY  MOMENT 


REAL  NU 

X=2.*SQRT<Z»Z1 VT 

CHECK  FOR  ERRORS  IN  NU  AND  X  AND  EXIT  IF  ANY  ARE  PRESENT 

1ER>:0 
Bl-f . 0 

IF<NU)10,15,10 
10  IF<X>160,20.20 
15  IF<X>t60,  17,20 
17  ARC— <Z+Z1VT 

IF<ARG  .LT.  -80. >  GO  TO  170 

BI-EXP<ARC )/T 

RETURN 

DEFINE  TOLERANCE 
20  TOL=1  E-3 

IF  ARGUMENT  GT  12  AND  GT  NU,  USE  ASYMPTOTIC  FORM 


GRV00360 
GRV00370 
GRV00380 
GRVU0390 
GRV00400 
CRV0041 0 
GRV00420 
GRV00430 
GRV00440 
GRVG0450 
GRV00460 
GRV00470 
GRV004dO 
GRV00500 
GRV0051 0 
GRV 00520 
GRV00530 
GRV00540 
GRVOuSSO 
GRV00560 
GRV00S70 
GRV 00580 
GRV00590 
GRV00600 
CRVOOStO 
GRV00620 
CRV00630 
GRV 00640 
GRV00650 
GRV00660 
GRV00670 
GRV 00680 
CRV00690 
GRV00700 
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IF<X-12. >40,40,30 
30  IF<X-ABS<NU>>40,40,  1  1  0 

COMPUTE  FIRST  TERM  OF  SERIES  PND  SET  INITIAL  VALUE  OF  THE  SUM 

40  XX*X/2. 

N=INT<NU> 

FN=N 

R=NU-FN 

CALL  GAMMA< 1 .♦NU,GR, IER> 

IF< lER  .EQ.  0>  GO  TO  so 
50  BI=0. 0 
RETURN 

so  TERM=1  .,^GR 
70  BI=TERM 
XX=XX*XX 

COMPUTE  TERMS,  STOPPING  WHEN  ABS<TERM>  LE  ABS< SUM  OF  TERMS >*T 
DO  90  ,  »  000 

IF<  ABS<  TERM  )-ABS<  Blf TOL  >>95,95,80 

80  fk=k; 

FK*Fk*< NU+FK  > 

TERM=TERM*<XX/'FK> 

90  BI*=BI+TERM 
95  ARG=-<2+21 >XT 

IF<ARG  .LT.  -80. >  GO  TO  170 
BI=BI*<2f/T>**NU-*EXP<ARG  )/T 

RETURN  BI  AS  ANSWER 

100  RETURN 

X  GT  12  AND  X  GT  NU,  SO  USE  ASYMPTOTIC  APPROXIMATION 

110  FN=4  .  <*NU*NU 
115  XX=1  ,/'<8.*X> 

TERM«=1  . 

BI  =  1  . 

DO  130  K«1,30 

1F< ABS<TERM>-ABS<Bl*TOL>>  140,140,120 
120  FK*<  Z*K-1  >**2 

TERM=TERM*XXf<<  FK-FN  >XFLOAT<:  K  > 

130  BI«ei+TERM 

SIGNIFICANCE  LOST  AFTER  30  TERMS,  TRY  SERIES 
GO  TO  40 

140  PI-3. 141 592S53 
ARG=X-<2+21 

IF<ARG  .LT,  -80. >  GO  TO  170 
e  I  »e  I ■*<  Z 1 XZ  >♦♦<  NU/2 .  >*EXP<  arc  >XS0RT<  2 .  *PI*X  >/T 
GO  TO  100 
160  IER-5 

GO  TO  100 
170  BI»0. 0 
GO  TO  50 
END 


GRV00710 
GRV00720 
GRV00730 
THE  SUM  GRV00740 
GRV 00730 
GRV00760 
GRV00770 
GRV00780 
GRV00790 
GRV00800 
GRV0081 0 
GRV00820 
ORV00830 
GRV 00840 
GRV00850 
ORV00860 
GRV00&70 
TERMS  >*TOLERAGRV00880 
GRVOOSSO 
CRV00900 
GRV 0091 0 
GRVC0920 
GRV00930 
CRV00940 
CkV0095u 
GRV00960 
GRV 00970 
GRV00980 
GRV00990 
GRV01 000 
GRV01 01 0 
GRV01 020 
CRV01 030 
GRV01 040 
CRV01 050 
CRVOl 060 
CRV01 070 
GRV01 OBO 
GRV01090 
GRV01 1 00 
GRVOt 1 10 
GRV01 120 
GRV01 130 
GRV01 140 
GRV01 1 50 
GRVOt 160 
GRV01 170 
GRV01 130 
GRV01 190 
CRV01200 
GRV0121 0 
GRV01220 
GRV01230 
GRV01240 
GRV01250 
GRV01260 
CRV01270 
CRV01280 
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SUBROUTINE  HOMENT< VGRAV , 21H , H, TIN. Q. XBhR, S1GU2, S1GR2 >  MuMOOOlO 

REAL  M,N,NM  MOM00020 

DIMENSION  AL<9  >,  2<  9),T<9>,XB<81 ,4,3>.SW<81 ,4,3>,SP<81 ,4,3>,NM<9>  MOM00030 

DIMENSION  VALC 1 6  ) , XVAL< 8  ) . W< 8  )  . XI < 4 > , IB< 4  ) . NTC< 4 ) , 1 1< 4 ) , XC 9 , 4 )  MOM00040 

LOGICAL  FIRST  MOM00050 

COMMON  /'UNOPRM,''DXZO,OYXO,D20,UO,M,H,2INV  MOM00060 

COMMON  XIOUNIT/IOIN, lOOUT , IPHFUN, LOUNIT, NDIRTU, NCLIMT, KSTOR, NPLOTUMOM00070 


EQUIVALENCE  < Z< I  >, X< 1 , 1  >  ) , < T< 1  > , X< 1 , 2 > > , < AL< 1  > , X< 1 . 3 > > 
EQUIVALENCE  < NH< 1  >, X< 1 , 4  )  > 

DATA  FIRSTX .TRUE .7, IB/4,4,  1 ,2/, I TC/ > 1 /, HREF/ 1  . / 

H<  *  4>  *«>««»%  <ti  Ik  *  4>  Id  i|>  >l>  I*  Hi «  *  4<  *«>)■<•>  X>  4i  ««<•<  41 «  4i  4i  «>!•  >i>  ««  4c  sK  :f 

PURPOSE 

TO  CONVERT  PARAMETERS  TO  HONDIMENSIONAL  FORM  AND  THEN  COMPUTE 
THE  2ERO  ORDER  MOMENT  AND  INTERPOLATE  FROM  TABULATED  VALUES  OF 
THE  HIGHER  ORDER  MOMENTS 


INPUT 

VGRAV 

2IN 

H 

TIN 

OUTPUT 

Q 

XBAR 

3IGU2 

SIGP2 


THE  GRAVITATIONAL  SETTLING  VELOCITIES  OF  THE  PARTICLE 
IN  METERS  /  SEC 

THE  HEIGHT  < METERS >  AT  WHICH  THE  MOMENTS  ARE  DESIRED 
THE  HEIGHT  OF  RELEASE  OF  THE  PARTICLES  IN  METERS 
THE  TIME  IN  SECONDS  AFTER  RELEASE 


THE  VERTICAL  CONCENTRATION  OF  PARTICLES  AT  HEIGHT  2 
THE  DISPLACEMENT  <METERS>  IN  THE  X  < IE  WIND)  DIRECTION 
OF  THE  CENTER  OF  HA-SS  OF  PARTICLES  AT  HEIGHT  2 
THE  SQUARE  OF  THE  STANDARD  DEVIATION  OF  THE  UIHDWARD 
DISPLACEMENT  OF  THE  PARTICLES  AT  HEIGHT  "  ‘ 

THE  SQUARE  OF  THE  STANDARD  DEVIATION  OF 
DISPLACEMENT  OF  THE  PARTICLES  AT  HEIGHT 


Z  IN  METERS>**2 
THE  CROSS-WIND 
2  IN  METERS>k*2 


SUBROUTINES  CALLED 


DTERP3  PUTS  THE  NEEDED  VALUES  OF  THE  TABULATED  MOMENTS 
INTO  A  ONE-DIMENSIONAL  ARRAY 

DTERPI  A  FUNCTION  WHICH  RETURNS  THE  INTERPOLATED  VALUE 
FOR  GIVEN  ARGUMENTS  AND  ARRAYS 
GREEN  CALCULATES  THE  GREENS  FUNCTION  WHICH  IS  THE 
O-ORDER  MOMENT 

CALLED  BY  CWINO 

4i  9|I)||  ]fi  %  4t  %  41 4i  ^  41 4|  *  4>  41 4>  4|  <|i  4*  4r  %  4i  4i  4r  %  4i  %  i(t  %  1|I  ill  %  %  III 

IF< .NOT ,FIRST)GO  TO  5 

READ  IN  THE  TABLE  OF  MOMENTS  ON  THE  FIRST  CALL  OF  MOMENT 


Z 

T 

AL 

NM 


XB 

8W 

SP 


LOG 

LOG 


OF 

OF 


NON-OIMENSIONAL 

NON-DIMENSIONAL 


HEIGHTS 
TIMES 


AT 

AT 


WHICH 

WHICH 


MOMENTS 

MOMENTS 


ARC 

ARE 


NON-DIMENSIONAL  SETTLING  VELOCITIES  AT  WHICH  HOHEHTS  ARE 
TABULATED 

OIFFUSIVITY  POWER  LAW  EXPONENTS  AT  WHICH  MOMENTS  ARE 
TABULATED 


MOM00080 
MOM00090 
MOM001 00 
MOM001 1 0 
MOM00120 
MOM001 30 
MOM00140 
MOMOOiSO 
MOM00160 
MOMOui 70 
MOMOOISO 
MOMOO) 90 
MOM00200 
M0M0021 0 
MOM00220 
MOM00230 
MOM00240 
MUM00250 
MOM00260 
MOMU0270 
HOM00280 
MOM00290 
MOM0G300 
MOM0031 0 
MOM00320 
MOM00330 
MOM00340 
MOM00350 
MOMOOSSO 
MOM00370 
MOM00380 
HOM00390 
MOM 004 00 
MOM0041 0 
MOM00420 
MOM00430 
MOM00440 
MOM 00450 
M0M00460 
M0M0047O 
MOM00480 
MOM00490 
MOM00500 
MOM0051 0 
M0M00520 
MOM00530 
MOM00540 
TABULAM0M00550 
TABULAMOM00560 


MOM00570 
H0H005S0 
MOM00590 
MOM00600 
MOM 0 08 «  0 
MOM00620 
MOH00630 


TABULATED  VALUES  OF  LOGS  OF  FIRST  ORDER  MOMENTS  (RELATED 
TO  MEAN  HORIZONTAL  DISPLACEMENT) 

TABULATED  VALUES  OF  LOGS  OF  WIND  SHEAR  COMPONENT  OF  SECOHDHOH00640 
ORDER  MOMENT  (CONTRIBUTES  TO  VARIANCE  IN  WIND  DIRECTION)  HOM00850 
TABULATED  VALUES  OF  LOGS  OF  SECOND  ORDER  MOMENT  COMMON  TO 
WIND  AND  CROSS-WIND  VARIANCES 


READ(NDIRTU, t ) 
1  F0RMAT(4I3) 


NZ,NT,NA,NN 


MOM00860 
MOM00670 
MOM 00680 
MOH00690 
HOM00700 
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<:z<  I  I-1  ,N2> 


<T(  I  ) 
<AL<  I  >,  I 
<NM<  I  ),  1 


1=1 ,NT> 

1  ,Nfl> 
1  ,NN> 


<<XB<  I  J,K,L>,  IJ»1  ,NZT>,K=1 
<<SUI<  I  1  J*1,NZT),K-1. 

<  <  SP< IJ , K , L  > , IJ* 1 / NZT ) . K- 1  ; 


NA> 

NA> 

NA> 


NTC< 1  ;=N2-1 
NTC<2>=NT-1 
NTC<3)=Nh-1 
NTC<4)=NN-1 
READ<NDIRTU,2> 

2  F0RMAT<6E13.5) 

REA0<NDIRTU,2i 
READ<NDIRTU,2) 

READ<NDIRTU,2> 

N2T=NZ*NT 
DO  3  L=1,NN 
READC  NDIRTU, 2  > 

REftD<NDIRTU,2 J 
READ<NDIRTU,2) 

3  CONTINUE 
FIRST= .FALSE. 

REWIND  NDIRTU 

5  CONTINUE 

CONVERT  INPUT  PARAMETERS  TO  NONDIMENSI ONAL  FORM 

SCLU=DZ0*H**<N-1  .  ) 

XI<  1  >=21N/^H 
XI<2>=SCLU*TIN/'H 
XI<3>=VGRAV/'SCLU 
XI<4)=N 

CALL  GREENt  XK  1  HREF,  XK 2  ),  Xr<  3  >,  Q,  lER) 

Q=Q^H 

IF<Q  .LE.  1 .E-t  0>  GO  TO  999 

TAkE  i  OGS  FOR  LOGARITHHIC  INTERPOLATION 

XI< 1  )-AL0G<XI< 1 )> 

XI<2)-AL0G<XI<2)) 

DETERMINE  INDICES  OF  LOWEST  CORNER  POINT  OF  THE  CUBE  TO 
BE  USED  IN  INTERPOLATION  MAKING  SURE  THAT  ENOUGH  CORNER  POINTS 
OF  THE  CUBE  HAVE  TABULATED  VALUES 

DO  too  1*1,4 
II< I >=IB< I  ) 

00  CONTINUE 

DO  101  111=1,4 
1=5-111 
IA=II< I ) 

IF<XI< I > 

IF<XI< I > 

IF<XI<  I  ) 

ISAV-II< I > 

IK  I  >=IA  + 

IT=0 

DO  102  JI=1,2 
JIX»JI  +  IK  1  )  - 
DO  102  IJ=1,2 
I JX=JIX  +  < IJ  ♦ 

DO  1 02  K*1 ,2 
KX=K-1  +  II<3) 

DO  102  L*1,2 
LX=L-1  ♦  IK4) 

IF<XB< I JX,KX,LX) 

02  CONTINUE 

IF<1T  .GT.  ITO  GO  TO  6 
IK  I  )=ISAV 
01  CONTINUE 


.GE. 
■  LT, 
.GT, 


X< lA, I 
X< lA,  I 
X< lA,  I 


.AND. 
.AND. 
.AND  . 


XK 

lA 

lA 


I  >  .LE 


EQ. 

EO. 


1  > 


X< lA+1 
GO  TO 


I  )> 
01 

HTC< I >  >  GO  TO 


GO  TO  101 
1  01 


IFIX<SIGN< 1 . ,XI< I )-X< lA, I >)> 


1 


II<2>  -  2)t<NZ 


GT.  -100.)  IT»IT^^1 


PERFORM  THE  INTERPOLATION  WITH  DETERMINED  CUBE  OF  POINTS 

DO  103  1-1,4 
I2*I*2 
11*12-1 


MOM0071 0 
MOM00720 
MOM00730 
MOM0074CI 
MOM00750 
MOM00760 
M0iiu077o 
MOM00780 
MOM00790 
MOM00800 
MOtiuOdI  0 
MOM00820 
MOM00830 
MOM00840 
MOM00850 
MOM 00860 
MOM 00870 
MOM00880 
MOM00890 
MOM00900 
MOM0091 0 
MOM 00920 
MOM00930 
MOM 00940 
MOM00950 
HOM00960 
MOM00970 
MOM00980 
HOM00990 
MOMOl 000 
MOM01 01 0 
MOMOl 020 
MOMOl 030 
MOMOl 040 
MOMOl 050 
MOMOl 060 
MOMOl 070 
MOMOl 080 
MOMOl 090 
MOMOl 1 00 
MOMOl 1 1 0 
MOMOl 120 
MOMOl 130 
MOMOl 140 
MOMOl 150 
MOMOl 160 
MOMOl  170 
MOMOl 180 
MOMOl 190 
MOM01200 
MOM0121 0 
MOM 01 220 
MOM01230 
MOMOl 240 
MOM01250 
MOM01260 
MOM01270 
MOM01280 
MOM01290 
MOM01300 
MOM0131 0 
MOM01320 
MOM01330 
MOM01340 
MOM01350 
MOM01360 
MOM01370 
MOM01380 
MOM01390 
MOM01400 
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) 


Ih=II< 1  } 

XVAL<  11  )=-X<  I  > 

XVAL< 12)=X< IA+1 , I J 
103  CONTINUE 

CALL  DTERPS< II,XB, VHL,NZi 
XBAR=DTERP I <  4 , X I , XVAL , VAL . - 1 00 . , W  > 

CALL  DTERPS< II,SU.VAL,N2) 

SI GW2=DTERP I < -4 , XI ^  XVAL , VAL , - 1 0 0 . , U  > 

CALL  DTERPS< 1I,SP,VAL,N2) 

S1GP2»1>TERPI<-4,XI  .XVAL,  VAL,-1  0  0.  .W> 

C  CONVERT  THE  LOG  OF  THE  NOHDINEHSIOHAL  VALUES  INTERPOLATED 
C  TO  THE  USUAL  DIMENSIONAL  FORM 
C 

3CL=U0>t'HH<#<  M+1  .  j/’SCLU 
XBAR=*SCL*EXP<XBAR> 

SIGul2“SCL*SCL*EXP<  3IGW2  ) 

SIGP2=2  .  t.DX2  0*H*H*EXP<  S1GP2  ) 

SIGUj2=SIGU2-*-SIGP2 
SIGP2-DYX0*SIGP2 
999  RETURN 
END 


MOMol 41 0 
MOM01420 
MOM01430 
MOM01440 
MOM01450 
MOM01460 
MOM01470 
MOM01480 
MOM01490 
MOM01S00 
MOM0151 0 
MOM01520 
MOM01530 
MOM01540 
MOM01550 
MOM01560 
MOM01570 
M0M01580 
MOMOl 590 
MOM01600 
MOMOIbl 0 
MOM01620 
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0000000000000000000000000000 


SUBkOUTINE  P|!»TH<  T.  U,  XCEH  ,  YCEH,  RAD,  PlEN  > 

THIS  SUBROUTINE  COMPUTES  THE  PATH  LENGTH  THROUGH  THE  SPHERE  OR 
WAKE  FOR  A  HORIZONTAL  PATH, 

INPUTS 

T  -  TRANSMITTER  COORDINATE  IN  THE  LOCAL  COORDINATE  SYSTEM 

U  -  UNIT  VECTOR  ALONG  THE  LINE  CONNECTING  THE  TRANSMIITTER 

AND  RECEIVER 

XCEN  -  X  COORDINATE  OF  THE  CENTER  OF  THE  CIRCLE 

YCEN  -  Y  COORDINATE  OF  THE  CENTER  OF  THE  CIRCLE 

RAD  -  RADIUS  AT  THE  DESIRED  HEIGHT 

OUTPUT 

PLEN  -  LENGTH  OF  THE  INTERSECTION  OF  THE  CONE  AT  HEIGHT  T<3) 
AND  THE  LINE  OF  SIIGHT 


FUNCTIONS  AND  SUBROUTINES  NEEDED 
NONE 

Id  ,(1  Id*  *♦*♦**,»*  1(11(1  **  Id  I*  *  ♦♦*%****♦  It!*  ♦  <(1  ****«■>»  ♦■HHi  Ili*  nn* '***>***>(•>•>(•♦>••'*•'**  I* 

DIMENSION  T<3>,U<3) 

A=U<  1  )>»i*i2+U<  2  )«*2 
PLENaO . 

X»RAD*f2f  A-<  U<  2  )*<  T<  1  )-XCEN  >-U<  1  >♦<  T<  2  >-YCEN  >  >f>»2 

IF  <  X  .  GT  .  0  .  >  PLEN»2  .  ■••SQRT<  X  )/A 

RETURN 

END 


PATH0290 
PATHOOl 0 
PATH0020 
PATH0030 
PATHCi040 
PATH0050 
PATH0060 
PATH00?0 
PATHOObO 
PATH 0090 
PATHOt  00 
PATH01 1 0 
PATH0120 
PATH0130 
PATH01 40 
PATH0150 
PATH0160 
PATHOI 70 
PATHOi SO 
PATHOiSO 
PATH0200 
PATH021 0 
PATHO220 
PATH0230 
PATH0240 
PATH0250 
PATH0260 
PATH 02 70 
PATH0260 
PATH0300 
PATH03I 0 


PATH0400 
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SUBROUTIME  RERP<A,B^ 

DIMENSION  A<2).B<2> 

B  IS  ROTATED  90  DEGREES  COUNTERCLOCKWISE  FROM  A 
B< 1  >=-A<  2  > 

Bn  2  >=M  1  ) 

RETURN 

END 


PERuOOf  0 
PER00020 
PER00030 
PER 00 040 
PER00050 
PER00060 
PER00070 
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SUBkOUT I NE  PRECLC  NATMOS , ZTEMP , TMPMES , 2WND, UNDMES, THUHD , PH I , DHDT ,  PRE  0  0350 
1  CHWT,NCHRG.DETDEP.HS01L.DS0D,SILT)  PRE00360 

PREOOOt  0 

ROUTINE  TO  PRECOMPUTE  EXPLOSION  PRODUCED  DUST  CLOUD  AND  STORE  ON  PRE00020 
EXTERNAL  FILE  UNIT  IFILE  PRE00030 

PRE00040 

OUTPUTS  PREOOuSO 

PRE 00 060 

XC)  COEFFICIENTS  OF  QUADRATIC  FIT  TO  SLOPE  OF  LINE  DESCRIBING  PRE00070 
X  DISPLACEMENT  OF  CONE  <AL0NGWIHD;)  PRE00080 

PRE00090 

XCO  COEFFICIENTS  OF  QUADRATIC  FIT  TO  CONSTANT  TERM  OF  LINE  PREOOlOO 

DESCRIBING  X  DISPLACEMENT  OF  CONE  <ALONGWIND>  PRE00110 

PRE001 20 

22  COEFFICIENTS  OF  QUADRATIC  FIT  TO  HEIGHT  OF  TOP  OF  CLOUD  PRE00130 

PRE00140 

RT  COEFFICIENTS  OF  QUADRATIC  FIT  TO  THE  RADIUS  OF  THE  TOP  OF  THE  PRE00150 
CONE  PRE00160 

PREuulTo 

RB  COEFFICIENTS  OF  THE  QUADRATIC  FIT  TO  THE  RADIUS  OF  THE  CONE  PREOOIBO 
AT  A  HEIGHT  OF  THE  AVERAGE  OF  THE  DISC  SOURCES  PREOOISO 

PRE00200 
PRE 0021 0 

THE  ABOVE  OUTPUT  ARE  THE  COEFFICIENTS  OF  QUADRATIC  FITS  THROUGH  PRE00220 

THREE  CONSECUTIVE  POINT  IN  TIME.  THE  QUADRATIC  FITS  ARE  STORED  IN  PRE00230 

COMMONS  M05  ^  WITH  THE  ARRAV  TIMES  CONTAINING  THE  LAST  TIME  PRE00240 

OF  EACH  QUADRATIC  PIECE  WITH  THE  FIRST  STARTING  AT  0.0  PRE00250 

THE  FITS  ARE  WRITTEN  ONTO  A  FILE  INDICATED  BY  IFILE  USING  PRE00260 

A  BINARY  WRITE  PRE 00270 

THE  FITS  ARE  STORED  SUCH  THAT  PRE00280 

PRE 00290 

F<TIME:)=VAR<  1  ,  J>*TIME**2  +  VAR<  2,  J  >-*TIHE  +  VAR<3,J>  PRE00300 

PRE0031 0 

AND  TIME8<J-1)  <  TIME  <  TIMES<J>  PRE00320 

PRE 00330 

LOGICAL  SWITCH, CHANGE, DHDT  PRE00370 

REAL  K2,KX  PRE00380 

DIMENSION  T<3),FRB<3>,FRT<3>,FXC1<3>,FXCO<3),XB':3>,OWF<5,2>  PRE0  0390 

DIMENSION  F22<  3),ZTEMP<2  ),Tt1PMES<  2  ) , ZWND<  2  ) ,  WNDMES<  2  > , OWFC<  5  )  PRE 0  04 00 

COMMON  /lOUNITXIOIH, lOOUT, IPHFUN, LOUNIT , NDIRTU, NCL IMT , KSTOR , NPLOTUPRE 004 1 0 
COMMON,^OPTION/IOPT,  IFILE  PRE00420 

COMMONXDISCS/NDSCS, TDSC<  20  ), XDSC<  2  0  ), 2DSC<20  >, R2DSC<  20  >, ODSCC  20, 3  >PRE 0  0430 


RB  COEFFICIENTS  OF  THE  QUADRATIC  FIT  TO  THE  RADIUS  OF  THE  CONE 
AT  A  HEIGHT  OF  THE  AVERAGE  OF  THE  DISC  SOURCES 

THE  ABOVE  OUTPUT  ARE  THE  COEFFICIENTS  OF  QUADRATIC  FITS  THROUGH 
THREE  CONSECUTIVE  POINT  IN  TIME.  THE  QUADRATIC  FITS  ARE  STORED  IN 
COMMONS  M05  WITH  THE  ARRAV  TIMES  CONTAINING  THE  LAST  TIME 
OF  EACH  QUADRATIC  PIECE  WITH  THE  FIRST  STARTING  AT  0.0 
THE  FITS  ARE  WRITTEN  ONTO  A  FILE  INDICATED  BY  IFILE  USING 
A  BINARY  WRITE 

THE  FITS  ARE  STORED  SUCH  THAT 


F<TIME:)=VAR<  1  ,  J>*TIME**2 
AND  TIME8<  J-1  )  <  1 


VAR<2,  J>-*TIME 
IE  <  TIMES<  J> 


VAR<3, J> 


COMMON, •'BUOYCL/RSPH,DELT,VZ,XCM,YCM,ZCM,XTOP,YTOP,SPHNS<:  3  >,  TIM 
COMMON, 'M05/DMMMY<  604  >, DMM<  600 ), 

+  ICOUNT,T1MES<25),XCO<3,25>,XCK3,25>,RT(3,25>, 

+  RB<3,25),Z2<3,25) 

COMMON/VL/VLOAD 
COMMON/S 10X31002,5100 
C0MM0N/'CL0CK,''FT1ME,TWIND 

COMMON,-’TRAN/VTR ,  KZ ,  KX ,  TTR ,  XTR ,  ZTR  ,  QPUFF<  3  ),  SWI TCH ,  CHANGE 
COMMOH,''WNDPRM/DXZO,DYXO,  DZ0,U0,UM,DN,ZINV 
COMMONXGEOM/COSTH2, SINTH, SINTH2, VISEXT,RTPI , SCRN<  2  > 
COMMON/CARBXRCARB1 ,RCARB2 

COMMON  XCONSTXPI , P 12 , P IRAD, TWOPI , TORRMB , CDEGK 


t  r  r  A  ,  r  A  ^  f  r  A  nfnv  j  iwvr* 

DATA  OWFXl  , ,  ,93,  ,52,  .44,2,E-03, 1  . , 1  ,  ,  1  .  ,  1  . ,4 .E-03X 

DATA  OWFCXI . , . 95, . 5 , . 2 , 1 ,E-03X 

TINC*1 . 0 

TPRES=0, 0 

ICOUNT-0 

DEL*. 001 

T<3J=0, 0 

SUH2*0, 0 

FIND  AVERAGE  OF  THE  DISC  RELEASE  HEIGHTS  AND  THE  AVERAGE  OF  THE 
INITIAL  SPREADS  OF  THE  DISCS 

DO  5  J-1,ND9CS 
SUM2-SUM2-fR2DSC<  J  ) 

5  CONTINUE 


PRE00440 
PRE00450 
PRE00460 
PRE00470 
PRE00480 
PRE  Cl  0490 
PRE00500 
PRE 0051 0 
PRE00520 
PRE00530 
PRE00540 
PRE00550 
PRE00560 
PRE00570 
PRE00580 
PRE005S0 
PRE00600 
PREG061 0 
PRE00620 
PRE00630 
PRE00640 
PRE00650 
PRE00660 
PRE00670 
PRE00680 
PRE00690 
PRE00700 
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ZkEF*2. 0 
R0H2=SLIM2/NDSCS 
10  IC0UNT=IC0UNT+1 
DO  50  1=1,3 

T<  I  >-T<3>+FL0AT<  1-1  >tiTlHC 

FIND  THE  AVERAGE  OF  THE  MOMENTS  AT  HEIGHT  2REF 

CALL  AVRG<  2REF, T< 1 >, OTOT, XBAVRG, 31G2N/ SIG2V i 
IF<QTOT.LT. 1 .E-1 0>GO  TO  15 
SiG><=3QRT<  3IG2X+R0H2/2 .  ) 
SlGV=S£iRT<SIG2Y+R0H2/'2.  > 

FftB< I >=SQRT< SiGX*SIGy i*1 .5 
XB< 1  )=XBAVRG 
GO  TO  20 

15  CALL  W1N<2REF,UX,V> 

XB< 1 >=UX*T< I > 

FRB<  n=o.  0 

20  IF< T< I  )  . GT . TUIND >G0  TO  30 
CALL  RI3E<TFRES,T< I >,DEL> 

F22<  I  )=ZCM+<  2./3.  )h.RSPH 
IF<F22< I  ).GT.2IHV>FZ2< I )=2INV 
FkT< I j=RSPH 
XB<  2  )=XCM 
GO  TO  40 

30  XB<2)=XTR+VTR*<T< I )-TTR) 

3IGX2=SlG02+2  .  *i<X*<  T<  1  )-TTR  > 
SIG22=8IG02+2.*KZ*<T<;  I  >-TTR  > 

SIGX=SQRT<  31GX2 ) 

SIG2=SQRT<S1G22) 

3iG=SQRT<  SIGX«3IG2 ) 

FZ2< I  )=2TR+SIG 
FRT< I >=1 . 5*SIG 

4  0  FXCK  I  )=<XB<2)-XB<  1  )>AFZ2<  1  >-ZREF> 

FXC0<  I  )=XB<  1  )-FXC1<  1  >'»ZREF 
50  CONTINUE 

COMPUT  AND  STORE  QUADRATIC  FITS 

TIMES<  IC0UNT>=T<3;> 

FIT  AND  STORE  RADIUS  AT  TOP 

CALL  FIT<T,FRT,A,B,C) 

RT< 1 , ICOUNT  >-A 
RT<2, ICOUNT)=B 
RTCS, ICOUNT >=C 

FIT  AND  STORE  RADIUS  AT  BOTTOM 

CALL  FIT<T,FRB,A,B,C) 

RB< 1 , ICOUNT )*A 
RB<2, ICOUNT )=B 
RB<3, ICOUNT )«C 

FIT  AND  STORE  HEIGHT  OF  CLOUD 

CALL  FIT<T,FZ2,A,B,C> 

Z2< 1 , ICOUNT)=A 
22<2, ICOUNT ?=B 
Z2<3,  ICOUNT>=»C 

FIT  AND  STORE  XC1 

CALL  FIT<T,FXC1 ,A,B,C) 

XC1< 1 , ICOUNT >»A 
XC1<2, ICOUNT >=B 
XCU3,  ICOUNT  >»C 

FIT  AND  STORE  XCO 


PRE0071 0 
PRE00720 
PRE 00730 
PRE00740 
PRE00750 
PRE00760 
PRE00770 
PRE 00780 
PRE00790 
PRE00800 
PRE0081 0 
PRE00d20 
PkE00830 
PRE00d40 
PREOOdSO 
PREOOdSO 
PRE00870 
PREOOSSO 
PREOOaSO 
PRE00900 
PRE0091 0 
PRE00920 
PRE00930 
PRE00940 
PRE00950 
PRE00960 
PRE 00970 
PRE 00980 
PRE00990 
PRE01 000 
PRE01 01 0 
PRE01 020 
PRE01 030 
PRE01 040 
PRE01050 
PRE01 060 
PRE01 070 
PRE01 080 
PRE01090 
PRE01100 
PRE01 1 1 0 
PRE01 120 
PRE01 130 
PRE01 140 
PRE01 150 
PRE01 160 
PRE01 170 
PREOl 180 
PRE01 190 
PRE01200 
PRE0121 0 
PRE01220 
PRE01230 
PRE01240 
PRE012S0 
PRE01260 
PRE01270 
PRE01280 
PRE01290 
PRE01300 
PREOl 31 0 
PRE01320 
PRE01330 
PRE01340 
PREOl 350 
PRE01360 
PREOl 370 
PRE01380 
PREOl 390 
PRE01400 
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SUBROUTINE  PRETRN<  TRN, REC . TIHE, TRNLOS > 

COMPUTE  THE  TRRN3MITTRNCE  FOR  THE  RANDOM  IN  SPACE  AND  TIME 
DISTRIBUTION  OF  CHARGES 

INPUTS 

TRN  -TRANSMITTER  COORDINATES  IN  LOCAL  COORDINATE  SYSTEM 
REC  -RECEIVER  COORDINATES  IN  LOCAL  COODINATE  SYSTEM 
TIME  -TIME  AT  WHICH  TRANSMITTANCE  IS  DESIRED 
NWL  -INTEGER  INDEX  FOR  WAVELENGTH 
NSOIL  -SOIL  TYPE 
OUTPUTS 

TRNLOS  -TRANSMITTANCE  ALONG  THE  SPECIFIED  LINE  OF  SIGHT 


«  4i «  4c  Id  Ik  ««  «*>)<  Ik  «•  Ilo*  «<>*<>•<  I*  O' ti  Ik  I*  >ti  m  *1  *•  %  >k  <k  W  >*  >K  ^  I*  H  4i  Hi 

LOGICAL  TEST 

DIMENSION  TRN<3>,REC<3>,TR<3>,REt3>,0WFc5,2>,UC3>,0WFC<5> 
COMMON/MO5<^DIFF<2,200>,NCHTOT,PRSEP<200>,HTOTiNARY,  ITOT, 

+  COOR<2,200>,TSTAG<200). 

+  ICOUNTi T1MES<  23  >, XC0<  3, 25  XC  K  3, 25  >, RT<  3, 25 

)  RB<3i2S),Z2<3,25> 

COMMONXVL/'VLOAD 

COMMONc'-TRANNY/THRESH,  TEST,  NWL  ,  NSOIL 
COMMON/'CARB/'RCARBl  ,RCARB2 

COMMON  /-CONSTc^Pl ,  PI2,  PIRAD,  TWOPI ,  TORRMB,  CDEGK 
DATA  OWF/1 . , .93, .52, .44,2.E-03, 1 . , 1 . , J . , t . ,4.E-03/ 

DATA  OWFC/1 , , .95, ,5, .2, 1 .£-03/ 

PARAMETERIZE  THE  LINE  CONNECTING  THE  TRANSMITTER  AND  RECEIVER 


TEST=>.  FALSE. 

XNORM=0. 0 
DO  10  1=1,3 
RE< I  )=REC< I > 

TR< I  )=TRN< I  ) 

U< I >=RE< I  )-TR< I  ) 

XNORM=XNORM+U< I >**2 
10  CONTINUE 

XNORM=SQRT<XNORM) 

U<  1  )=U<  1  )/'XNORM 
U<2)=U<2)/XN0RM 
U<  3  >=U<  3  VXNORM 

COMPUTE  THE  CONTRIBUTION  FROM  EACH  CHARGE  TO  THE  OPTICALLY 
WEIGHTED  CONCENTRATION  ALONG  THE  LINE  OF  SIGHT 

SUM=0, 0 

DO  100  I=1,ITOT 
IF<TIME.LT.TSTAG< I ))GO  TO  100 
TOF=TIME-TSTAG< I > 

IF<TOF.GT.TIMES< 1C0UNT>)G0  TO  100 

DO  20  J=1,ICOUNT 

IND«J 

IF<TOF.LE.TIMES< J)>GO  TO  30 
20  CONTINUE 

DETERMINE  NECESSARY  PARAMETERS  DESCRIBING  THE  CONICAL  SHAPE  SO  THAT 
THE  LENGTH  OF  INTERSECTION  OF  THE  LINE  OF  SIGHT  AND  CONE  CAN  BE 
DETERMINED 

30  XO=TOF=<XCO< 1 , IND  )*TOF*XCO< 2, INO>)+XCO<3, IND> 

X1=T0F4.<XC1<  1 ,  IHD  Jt>T0F*XC1<2,  IHD>)+XCU3,  IHD) 

HTT0P-T0F*<Z2<  I  ,  IHD>*T0F+Z2<  2,  IND>>-kZ2<3,  IND> 


PRT00220 
PRT0001 0 
PRTG0020 
PRT00030 
PRT00040 
PRT00050 
PRT00060 
PRT00070 
PRTOOOBu 
PRT00090 
PRT001 00 
PRT001 1 0 
PRT00120 
PRT00130 
PRT00140 
PRT00150 
PRT00160 
PRT00170 
PRTOOlSu 
PRT00190 
PRTOOZOO 
PRT0021 0 
PRT00230 
PRT 00240 
PRT 00250 
PRT00260 
PRT 00270 
PRT 00280 
PRT00290 
PRT00300 
PRT0031 0 
PRT00320 
PRT00330 
PRT00340 
PRT00350 
PRT00360 
PRT00370 
PRT00380 
PRT00390 
PRT00400 
PRT004tO 
PRT 00420 
PRT00430 
PRT 00440 
PRT00450 
PRT00460 
PRT00470 
PRT00480 
PRT00490 
PRT00500 
PRT0051 0 
PRT 00520 
PRT00530 
PRT00540 
PRT0u550 
PRT 00560 
PRT00570 
PRT00580 
PRT00590 
PRT00600 
PRT0061 0 
PRT00620 
PRT00630 
PRT0064G 
PRT00650 
PRT00660 
PRT00670 
PRTOOBBO 
PRT00690 
PRT00700 
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RTOP=TOF*<RT<  1  ,  IND  >*TOF-fRT<  2,  IND>)+RT<3,  IND> 

HTBOT-0. 0 

RBOT=TOF*<RB< 1 , IND >*T0F+RB< 2, IND>)+RB<3, IND> 

XCEN=DIFF< 1 , I )+<X1*HTTOP+XO> 

YCEN=DIFF<2, 1 > 

XB=C)IFF<  1  ,  I  )  +  <X1*HTBOT  +  XO> 

YB=DIFF<  2, I ) 

IF<ABS<U<3>>.LT. i ,£-06)00  TO  40 

COMPUTE  THE  INTERSECTION  LENGTH  FOR  P  N0H-H0RI20NTPL  LINE  OF  SIGHT 

CALL  C0NLEN<  U. TR. HTTOP. HT60T. XCEN, VCEN, RTOP , RBOT, XB. YB, 

1  XNORM.PLEN) 

GO  TO  50 

COMPUTE  THE  INTERSECTION  LENGTH  FOR  A  HORIZONTAL  LINE  OF  SIGHT 

40  IF<HTT0P.LT.TR<3)>G0  TO  45 
H=U<  i  ii<>»2+U<  2  >■*'•2 

B=Lt<  1  >•<  TR<  1  )-XCEN  :)+U<  2  )*<  TR<  2  >-yCEN  > 

DETERMINE  THE  RADIUS, X, AND  Y  POSITIONS  OF  THE  CONE  AT  THE 
TRANSMITTER  HEIGHT 

ZETA=TR<:  3),^HTTOP 
RAD»2ETA*RT0P+< 1 . -2ETA >*RBOT 
XCEN=2ETAfXCEN+< 1 . -ZETA  >f XB 
YCEN=2ETA*YCEN+< 1 ■ -ZETA  >*YB 
A“U<  1 

e-U<  1  >•*<  TR<  1  )-XCEN  )+U<  2  >*•<  TR<  2  >-YCEN  ) 

C=<  TR<  1  )-XCEN  )**2*<  TR<  2  >-yCEN  >**2-RAD4r>»2 

X=B'*>*'2-A>»C 

IF<X.LT. 0. 0)GO  TO  45 

P1=«<-B+SQRT<X))XA 

P2=(-B-SQRT<X>)/A 

IF<P1 .GT.XNORM.AND.P2.GT.XNORM>GO  TO  45 
IF<P2.LT.0.0.AND.P1 .LT.O.O>GO  TO  45 
PLEN=AMIN1<P1  ,XN0RM)-AMAX1<:P2,  0. 0> 

GO  TO  50 
45  PLEN=0.0 

50  VOL-<  PI/'S.  )*<HTT0P-HTB0T>ti<RT0P*'»2+RT0P*RB0T+RB0T>»'»2> 
CONT=VLOAD*PLEN/VOL 
SUM=SUM+CONT 
ACLSKT=0. 0 
ACLSPH-O. 0 

CALL  TRNCHK<ACLSKT,SUM,ACLSPH) 

IF<TEST)GO  TO  998 
100  CONTINUE 

TRNLOS«=EXP<  -SUM*<  RCARB1  •OUF<  NUL,  NSOIL  >+RCARB2>*0UFC<  NUL  >  >  > 

GO  TO  999 

998  TRNLOS=0.0 

999  RETURN 
END 


PRT0071 0 
PRT00720 
PRT00730 
PRT00740 
PRT00750 
PRT00760 
PRT00770 
PRT00780 
PRT00790 
PRT00800 
PRT0081 0 
PRT00820 
PRT00830 
PRT00840 
PRT00850 
PRT 00860 
PRT00870 
PRT00S80 
PRT  00890 
PRT  0  0900 
PRT 0091 0 
PRT00920 
PRT00930 
PRT 00940 
PRT00950 
PRT00960 
PRT  00970 
PRT00980 
PRT00990 
PRT01 000 
PRT01 01 0 
PRT01 020 
PRT01 030 
PRT01 040 
PRT01 050 
PRT01 060 
PRTOi 070 
PRT01 080 
PRTOI 090 
PRTOI 1 00 
PRTOI 1 1 0 
PRTOI 120 
PRTOI 130 
PRTOI 140 
PRTOI 150 
PRTOI 160 
PRTOI 170 
PRTOI 180 
PRTOI 190 
PRT01200 
PRT0121 0 
PRT01220 
PRT01230 
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SUBROUTINE  PREVENT NSOIL , NUL > 

ROUTINE  FOR  PRECOMPUTING  VEHICLE  GENERATED  DUST  CLOUD 

INPUTS 

NSOIL  -  SOIL  TYPE  < SEE  DRTRAN  FOR  DETAILS) 


-  WAVELENGTH  INDEX  <SEE  DRTRAN) 


OUTPUTS 


RT  -  COEFFICIENTS  OF  QUADRATIC  FIT  TO  RADIUS  OF  THE  CLOUD 

Z2  -  COEFFICIENTS  OF  QUADRATIC  FIT  TO  HEIGHT  OF  THE  CLOUD 

XC1  -  COEFFICIENTS  OF  QUADRATIC  FIT  TO  SLOPE  OF  LINE  DESCRIBING 

X  DISPLACEMENT  OF  CONE  <ALONGUiND) 

XCO  -  COEFFICIENTS  OF  QUADRATIC  FIT  TO  CONSTANT  term  OF  LINE 
DESCRIBING  X  DISPLACEMENT  OF  THE  CONE  <A10NGWIND) 

THE  ABOVE  OUTPUT  ARE  THE  COEFFICIENTS  OF  QUADRATIC  FITS  THROUGH 
THREE  CONSECUTIVE  POINTS  IN  TIME.  THE  QUADRATIC  FITS  ARE  STORED  IN 


COMMON,-' 

INTERVAL 


PRV00360 
PRV0001 0 
PRV00020 
PRV00030 
PRV 00040 
PRV00050 
PRV 00060 
PRV00070 
PRV00080 
PRV00090 
PRV001 00 
PRV001 1 0 
PRv00120 
PRV00130 
PRvOOi 40 
PRV00150 
PRvOOiSO 
PRV00170 
PRVOOiSO 
PRVOOtSO 
PRV00200 
PRV0021 0 
PRV00220 
PRV00230 
PRV00240 


M05  WITH  THE  ARRAY  TIMES  CONTAINING  THE  LAST  TIME  OF  THAT  PRV00250 
THE  FITS  ARE  WRITTEN  ONTO  A  FILE  INDICATED  BY  IFILE  USING  PRV00260 


THE  FITS  ARE  STORED  SUCH  THAT 

F<TIME)=VAR<  1  ,  J>*TIME*i*i2  *  VAR<  2,  J  >*TIME  VAR<3,J> 
AND  TIME3<V-1)  <  TIME  <  TIMES<J) 


PRV00370 
PRV 00380 
PRV00390 


A  BINARY  WRITE.  PRV00270 

PRV00280 

THE  FITS  ARE  STORED  SUCH  THAT  PRV00290 

PRV003u0 

F<TIME)=VAR<  1  ,  J>*TIME*i*i2  *  VAR<  2,  J  >*TIME  *  VAR<3,J>  PRV00310 

PRV00320 

AND  TIME3<V-1)  <  TIME  <  TIMES<J)  PRV00330 

PRV00340 

4i«it,i|ii|lit<it<0ci«i«iikitiK<Ki4ii|i4i4ii*i>^if'4i*!k4l4iik4i«i4lK<ik4il|<lli>ki»ilii)i4tlti4lltt>|i4ilt<l|<4tl(iit>l*i>(i4i<klti*lki«l>tiK<lliltl*it<lk)|ll«i!(il|l4i  PRV  0  035  0 
LOGICAL  H0RI2  PRV00370 

DIMENSION  0UF<5,2),T<3>,FR(3>,FZ2<3>  PRV00380 

DIMENSION  FXC1<3),FXC0<3),XB<2)  PRV00390 

COMMON/DISCS/NDSCS,  TDSC<  2  0  ),  XDSC<  20>,2DSC<  2  0  >,  R2DSC.<  20  >,  QDSC<  2  0, 3  >PRV0  04  00 
COMMON/’PRE/'ZTO,RT2D2  PRV0041  0 

COMMON/MODE/HORIZ  PRV00420 

C0MM0N/M05/'DIFF<  2, 200  ),  NCHTOT,  PRSEP<200  >,  NTOT,  NARY,  ITOT,  DMM<  600  >,  PRV 0043  0 
+  ICOUNT,T1MES<25>.XCO<3,25>,XCK3,25),RT<3,25),  PRV00440 

RB<3,25),22<3,25>  PRV00450 

COMMON  /lOUHIT/IOIH, lOOUT, IPHFUN , LOUNIT , ND IRTU , NCLIMT , KSTOR , HPLOTUPRV 0 0460 
COMMON7PRTINF/RO,VGRAV<3  ),NPRTS  PRV00470 

C0MM0N/GE0M/C0STH2,SINTH,SINTH2, VISEXT,RTPI,SCRN<2>  PRV00480 

COMMON  /'C0NST/'PI,PI2,PIRAD,TW0PI,T0RRMB,CDEGK  PRV00490 

PRV00500 

DATA  OWF,-'!  .  ,  .93,  .52,  .44,2.E-03,  1  . ,  1  .  ,  1  . ,  1  .  ,4.E-03/  PRV0051  0 

PRV00520 

SET  UP  CORRECT  PARAMETERS  SO  THAT  CWIHD  CAN  BE  USED  PRV00530 

PRV00540 

NARY=1  PRv00550 

IT0T=1  PRV00560 

NT0T=1  PRv00570 

NCHTOT-1  PRV00580 

HORIZ=.TRUE.  PRV00590 

ONEM=-t.  PRV00600 

COSTH-1.0  PRV00610 

SINTH=0,0  PRV00620 

C0STH2»C0STH**2  PRV00630 

SINTH2«SINTHii*2  PRV00640 

SCRN< 1  )=SINTH  PRV00650 

SCRN<2)>-C0STH  PRV00660 

X=0.0  PRV00670 

Y«0.0  PRV00680 

TMAX-1000.  PRV00690 

C  PRV00700 


( 
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C 

C 

C 

c 


CONFUTE  R  ,  22  ,  XC1  ,  XCO  FT  THREE  CONSECUTIVE  TIMES  WITH  SPACING 
TINC  AND  THEN  CALL  FIT  ,  WHICH  CALCULATES  A  QUADRATIC  FIT  TO  THESE 
POINTS  AND  STORE  THEM  IN  COMMON  /QUADFT/ 


TIHC-1 . 0 
ICOUNT-0 
T<  3  >=0 . 0 

10  ICOUNT*lCuUHT+1 
DO  20  lei, 3 

T< 1  )=T<3>+FL0AT< 1-1  )*TINC 
2REF=2T0+SQRT<T<  I  )  )>*RT2D2 
TOF  =  T<  I  >-TDSC<  NDSCS  .) 

CALL  MOMENT<  VGRAV,  iSREF ,  2DSC<  1  >,  TOF ,  Q ,  XBAR,  S I  GUIS  ,  S I GP2  > 
COMPUTE  R  THE  RADIUS  OF  THE  CLOUD 


R0H2eR2DSC< 1 > 

SlGWeSQRT<SIGW2+R0H2/’2.  ) 

SIGP=SQRT< SIGP2+R0H2/2 . ) 

FR<  I  >=1 .5*SuRT<SIGW>*SlGP) 

ACl=CWIND<X,  Y,ZREF,T<  I  )  >>*‘OUIF<  NWL ,  NSOtL  > 

COMPUTE  22  APPROXIMATE  HEIGHT  OF  THE  CLOUD 

F22<  I  2  .  ■•■QDSC<  1,1)  )/Pl,^FR<  I  )/ACL 
222eFZ2< 1 ) 

COMPUTE  THE  X  POSITION  OF  THE  CLOUD  AT  A  HEIGHT  OF  Z2  AND  A  HEIGHT 
OF  1  METER. 

CALL  MOMENT<VGRAV, 222, 2DSC<  1  ), TOF, Q, XBAR, SICU)2,SIGP2) 
XB<2)=XBAR+XDSC< 1 ) 

21-1.0 

CALL  MOMENT<VGRAV, 21 ,ZDSC< 1 >, TOF, Q, XBAR, S1GW2, SIGP2 > 

XB< 1  )eXBAR+XDSC< 1  ) 

FXC1<  I  >=<XB<2>-XB<  1  ))A222-21  ) 

FXC0< I  )=XB< 1  )-FXC1< I  ) 

20  CONTINUE 

COMPUTE  AND  STORE  THE  QUADRATIC  FITS 

TIMES< IC0UNT)-T<3) 

FIT  AND  STORE  THE  CLOUD  RADIUS 

CALL  FIT<T,FR,A,B,C) 

RT< 1 , ICOUNT)=A 
RT<2, ICOUHT)-B 
RT<3, ICOUNT)-C 

FIT  AND  STORE  22,  APPROXIMATE  CLOUD  HEIGHT 

CALL  FIT<T,FZ2,A,B,C> 

Z2< 1 , ICOUHT>-A 
Z2<2, ICOUNT>=B 
Z2<3, 1C0UNT)=C 

FIT  AND  STORE  XC1 

CALL  FIT<T,FXC1 ,A,B,C) 

XC1< 1 , ICOUNT>-A 
XCK2,IC0UNT)eB 
XC1<3,IC0UNT )=C 

FIT  AND  STORE  XCO 

CALL  FIT<T,FXCO,A,B,C> 

XC0< 1 , ICOUNT )-A 
XC0<2, ICOUNT >-B 
XC0< 3, ICOUNT  )=C 


PRV0071 0 
PRV00720 
PRV00730 
PRV00740 
PRV00750 
PRV00760 
PkV0u770 
PRV00780 
PRV0u750 
PRV00800 
PRV0081 0 
PRV00820 
PRV00830 
PRV00840 
PRV00850 
PRVOC186O 
PRVu0870 
PRV00880 
PRVU0890 
PRVOuSOO 
PRV0091 0 
PRV00920 
PRV00930 
PRV00940 
PRv 00950 
PRV00960 
PRv00970 
PRV00980 
PRV00990 
PRV01 000 
PRV01 01 0 
PRV01 020 
PRV01030 
PRV01 040 
PRV01 050 
PRV01 060 
PRV01 070 
PRV01 080 
PRV01 090 
PRV01 1 00 
PRV01 1 1 0 
PRV01 120 
PRV01 130 
PRV01 140 
PRV01 150 
PRV01 160 
PRV01 170 
PRVOt 180 
PRV01 190 
PRV01200 
PRV0121 0 
PRV01220 
PRV01230 
PRV01240 
PRV01250 
PRV01260 
PRV01270 
PRV01280 
PRV01290 
PRV01300 
PRV0131 0 
PRV01320 
PRV01330 
PRV01340 
PRV013S0 
PRV01360 
PRV01370 
PRV01380 
PRV01390 
PRV01400 
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TINC=*1  .2*i<TINC 

IF<1COUNT.LT.20.AND.T<3>.LT.TMAX)  GO  TO  10 

RETURN 

END 


PRV0141 0 
PRV01420 
PRV01430 
PRV01440 
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SUBROUTINE  RISE< TPRES. TNEXT, DEL ) 

REAL  M,NDIF,KZ,KX 
LOGICAL  SWITCH, CHANGE 
DIMENSION  MK< 12,6) 

COMMON/BUOYCL/*  Y<  8  ),  SPHNS<  3  >,  RISTIM 
COMMON  /'WNDPRM,'  DX20 ,  DYXO,  DZ 0,  UO,  M,  NDIF ,  2INV 
COMMON  /CLOCK/  TIME,TWIHD 
COMMON/STARS/USTAR, TSTAR, ZSTAR 
COMMON/EKTEMP/ZO, 2L , T 0 , TC 1 , TC2 ,  TC3 

C0MM0N/TRAN/VTR,K2,KX,TTR,XTR,2TR,QPUFF< 3), SWITCH, CHANGE 
COMMON/SIG/SIG02,SIGC 


RISOOOi 0 
RIS00020 
RIS00030 
RIS00040 
RIS00050 
RIS00060 
RIS00070 
RIS00080 
RIS00090 
RIS001 00 
RIS001 1 0 


COMMON  /lOUNIT/IOIN, lOOUT, IPHFUN, LOUNIT, NDIRTU, NCLIMT, KSTOR, NPLOTURIS001 20 


COMMON/D ISCS/NDSCS, TDSC<  20  > , XDSC<  2 0  > , 2DSC<  20  > , R2DSC(  2 0  > , 
1QDSC<20,3) 

COMMON,'BURST/ACCEL,  TBURST 

DATA  HMIN, ACCURC,WK,N,ND/ , 001 , .001 ,72*0 ,,8,12/ 

I*  «  « .|i  I*  «  «  III  *  Jtiiliiti  4, «  %  ,|i  4I 41 1)1  ,|i  4i  *  Iti  .ft  I*  « Id  « in  .(■  1(1 4i «  « If  41 «  « «  *  «  «  %  %  I*  ]<i  Hi  *  * 

PURPOSE 

THIS  ROUTINE  CALLS  A  RUNGA  KUTTA  ROUTINE  TO  INTEGRATE  IN  TIME 
THE  EQUATIONS  FOR  THE  RISt  OF  A  BUOYANT  CLOUD  BtGINNlNG  AT  TPRES 
ENDING  AT  TNEXT  UNLESS  THE  CONDITION  FOR  SWITCHING  TO  THE  WIND 
DISPERSION  MODEL  IS  ENCOUNTERED  IN  WHICH  CONVRT  IS  CALLED. 

SEE  SUBROUTINE  DIFEQ  FOR  THE  DEFINITIONS  OF  Y< I ) . 


ARGUMENTS 

TPRES 


AS  INPUT  TPRES  IS  THE  INITIAL  TIME  OF  THIS  SEGMENT  OF 


RIS00130 
R1S00140 
RIS00150 
RIS00160 
RIS00170 
RIS00180 
R I S  0  it  1  9  0 
R1S00200 
RlSDu21 0 
RIS00220 
RIS00230 
RISU0240 
R1S0U250 
RISCi0260 
RIS00270 
RI&00280 
RIS0u290 
RIS00300 
RIS0031 0 


INTEGRATION  AND  IS  RETURNED  WITH  THE  VALUE  OF  THE  LAST  RIS00320 


TNEXT 


SUCCESSFUL  INTEGRATION  STEP, 

THE  ENDTPOIHT  OF  THE  TIME  INTERVAL  WHICH  IS  INPUT. 


REQUIRED  SUBROUTINES 

RKM  A  RUNGA-KUTTA-MERSON  INTEGRATION  ROUTINE 

CONVRT  A  SUBROUTINE  WHICH  CONVERTS  THE  CURRENT  BUOYANT 
DUST  CLOUD  TO  A  NUMBER  OF  DISC  SOURCES  FOR  THE 
WIND  DISPERSION  MODEL.  A  GAP  TIME  DURING  WHICH  THE 
BUOYANT  MODEL  IS  CONTINUED  IS  COMPUTED. 

WNDCAL  COMPUTES  SCALED  WIND  SPEED  AT  A  SPECIFIED  HEIGHT 

DIFFUS  COMPUTES  DIFFUSIVITY  AT  A  SPECIFIED  HEIGHT 

CALLED  BY  DUSTCL 

*H< ********************************** **•**<•■*  .<********************** 

IF< TNEXT. GT.TWIND)GO  TO  999 
SWITCH=, FALSE. 

CHANGE*, FALSE. 

T2=TPRE3 

PERFORM  INTEGRATION  IN  SEGMENTS  OF  TIME 

1 0  DO  20  NT*f ,300 
Tt*T2 
T2*1 .2*T1 
IF< T2.LE. 0,  )T2«.5 
IF<  T2 . CT . TNEXT )T2=TNEXT 
IF  <DEL.LT .HMIH)DEL=HMIN 
CALL  RKM<N,T1 ,T2, Y,HMIN,DEl,ACCURC,WK,NO> 

CHECK  TO  SEE  IF  CLOUD  GROWTH  IS  DOMINATED  BY  WIND  DIFFUSION 
OVER  BUOYANT  RISE  BY  COMPARING  WIND  DIFFUSIVITY,  DIFW,  TO 
THE  EFFECTIVE  BUOYANT  DIFFUSIVITY,  DIFB  AND  IF  THE  HEIGHT 
OF  THE  CENTER  OF  MASS  IS  LESS  THAN  ZSTAR  SWITCH  TO  THE 


RIS00336 
RIS00340 
RIS00350 
RIS00360 
RIS00370 
RIS00380 
RIS0D39D 
RIS00400 
RIS004i 0 
RIS00420 
RISU0430 
RIS00440 
RIS00450 
RIS00460 
RI300470 
RIS00480 
RIS00490 
RIS00500 
RIS00510 
RIS00520 
RIS00530 
RIS00540 
RIS00550 
RIS00560 
RIS00570 
RIS00580 
RIS00590 
RIS00600 
RIS0061 0 
RIS00620 
R1S00630 
RIS00640 
RIS00650 
R1S00660 
RIS00670 
RIS00680 
RIS00690 
RIS00700 
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SUBROUT  I NE  RKM<  N . XL , XU , Y , HM I N , OEL , ACCURC , WX , ND  > 

NUMERICAL  INTEGRATION  ROUTINE  FOR  SYSTEMS  OF  ODE'S 
USING  THE  RUNGE-KUTTA-MERSON  TECHNIOUE 

INPUT  PARAMETERS 

H  -  NUMBER  OF  FIRST  ORDER  DIFFERENTIAL  EQUATIONS 
XL  -  INITIAL  ABCISSA  OF  THE  INTERVAL 
XU  -  THE  FINAL  ABCISSA  OF  THE  INTEGRATION  INTERVAL 
Y  -  A  SINGLY  DIMENSIONED  ARRAY  OF  LENGTH  N.  WHEN 
RKM  IS  CALLED  IT  MUST  CONTAIN  THE  VALUES  OF 
THE  DEPENDENT  VARIABLES  AT  XL.  UPON  RETURN 
TO  THE  CALLING  PROGRAM  Y  CONTAINS  THE  VALUES 
OF  THE  DEPENDENT  VARIABLES  AT  XU, 

HMIN  -  THE  MINIMUM  STEP  SIZE  THAT  WILL  BE  USED  FOR  THE 
INTEGRATION 

DEL  -  THE  INITIAL  ESTIMATE  OF  THE  STEP  SIZE  AND  UPON 

RtTURN  TO  THt  CALLING  PROGRAM  DEL  CONTAINS  THE 
FINAL  STEP  SIZE  USED.  THIS  VALUE  SHOULD  BE  USED 
IN  THE  NEXT  CALL  TO  PRODUCE  AN  EFFICIENT  INTEGRATION, 
DEL  IS  RETURNED  WITH  THE  VALUE  ZERO  IF  IT  NAS 
BEEN  HALVED  BELOW  HMIN. 

ACCURC  -  PREASSIGNED  ACCURACY  WHICH  IS  ALSO  USED  IN  ADJUSTING 
THE  STEP  SIZE. 

WK  -  AT  LEAST  A  BLOCK  OF  N  BY  6  FLOATING  POINT  LOCATIONS 
USED  FOR  A  WORK  ARRAY. 

ND  -  THE  DIMENSION  OF  ARRAYS  Y  AND  WK . 

IT  IS  REQUIRED  THAT  THE  USER  OF  RKM  WRITE  A  SUBROUTINE 
DEFINING  THE  DIFFERENTIAL  EQUATIONS.  THE  SUBROUTINE 
STATEMENT  SHOULD  LOOK  LIKE  -  SUBROUTINE  DIFEQc N, X, Y, VP >  . 

WHERE 

N  -  THE  HUMBER  OF  EQUATIONS 

X  -  THE  INDEPENDENT  VARIABLE 

Y  -  SINGLY  DIMENSIONED  ARRAY  OF  DEPENDENT  VARIABLES 

YP  -  SINGLY  DIMENSIONED  ARRAY  OF  THE  RATES  OF  Y  AT  X 

YP< I >  =  D  Y< I >/DX 

DIMENSION  Y<ND>,WK<ND,6) 

LOGICAL  FIRST, QUIT 

SET  UP  NEEDED  VARIABLES  UPON  ENTRY 

XN=XL 

H=DEL 

F1RST=.TRUE. 

QUIT=.FALSE. 

CHECK  IF  XN  IS  CLOSE  TO  XU 

20  IF<XN-fH  .LT.  XU>  GO  TO  30 
DEL-H 
H=XU-XN 
QUIT*. TRUE. 

IF< FIRST)  OEL*H 

MAKE  FIRST  CALL  TO  DIFEQ  AT  THE  BEGINNING  OF  INTERVAL 
30  CALL  DIFEQ<N,XN,Y,UK< 1 , 1 )> 

PERFORM  THE  RUNGE-KUTTA-MERSON  ALGORITHM 

40 

DO  50  1-1, N 


RKMOOOt  0 
RKM00020 
RKM00030 
RKM00040 
RKMuOOSO 
RKM00060 
RKM00070 
RKMOOOeO 
RKM00090 
RKM001 00 
RKM001 1 0 
RKMOOIZO 
RKMOOl 30 
RKM00140 
RKM0ti15u 
RKMOOtBO 
RKMOOl 70 
RKM00180 
RKMuOtSo 
RKM 002 00 
RKM0021 0 
RKM 00220 
RKM00230 
RKM00240 
RKM 00250 
RKM00260 
RKM00270 
RKM 00280 
RKMOuZSO 
RKM 003 00 
RKM003f  0 
RKM00320 
RKM00330 
RKM00340 
RKM00350 
RKM003B0 
RKM00370 
RKM00380 
RKM00390 
RKM00400 
RKM 0041 0 
RKM00420 
RKM00430 
RKM00440 
RKM00450 
RKM00460 
RKM00470 
RKM00480 
RKM00490 
RKM00500 
RKM0051 0 
RKM 00520 
RKM00530 
RKM00540 
RKM00550 
RKM 00560 
RKM00570 
RKM005SO 
RKM 00590 
RKM00600 
RKMOOSt  0 
RKM00620 
RKM00630 
RKM00640 
RKM00650 
RKMOOeSO 
RKM00670 
RKMOOSBO 
RKM 00690 
RKM00700 
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UK< I.3>=H3*WK< I, 1  ) 

50  WK< I,6>=Y< 1 )+UK< I-3> 

CALL  0IFEQ<N,XN+H3,WK< 1 ,6),UK< 1 ,2)> 

DO  60  1=1, N 

60  WK< I,6>»Y< I >+<UK< I,3>+H3fUK< I,2))/2. 

CALL  DIFEQ<N,XN+H3,WK< 1 , 6 > , «K< I , 2 ) > 

DO  70  1=1 ,N 

WK<  I,4)=H3*UIK<  I,2> 

70  UK< I,6)-Y< 1 >+<3.*UK< 1 , 3 >+9 . *UK< 1 , 4 ) )/e . 

CALL  DIFEQ<N,XN+H,'2.  ,WK<  1 .6),UX<  1 ,2)> 

DO  80  1=1, N 

UK<  I,5>=H3i.MK<  1,2) 

8  0  UK<  1 , 6)=Y<  1  )+<3.  *WX<  1 , 3  )-9  .  *UK<  1 , 4  )+1 2  .  ■*WK<  1 ,5  )>/2, 

CALL  0IFEQ<:N,XN+H,«X<  1 ,6  >.  WX<  1 ,2)) 

FIND  THE  LARGEST  RELATIVE  ERROR 

TEST=0, 

DO  90  I=i,N 
YX=Y< 1  ) 

IFCVX  .EQ,  0.)  YX=ACCURC 

E=<  <  «K<  1 , 3  )-9  .  i<WK<  1 , 4  )/'2  .  +4  .  ♦UK<  1 , 5  >-H3*yK(  1 , 2  >X2  .  >/5  .  >/'YX 
90  TEST=AMAX1<TEST, ABS<E)) 

F1RST=. FALSE. 

1F<TEST  .LT.  ACCURC)  GO  TO  100 

IF  THE  LARGEST  ERROR  13  GREATER  THAN  ACCURC  HALF  THE  STEP 
SIZE  AND  TRY  AGAIN, 

H=H/’2, 

IF<H  .LT.  HMIN)  GO  TO  10 
QUIT=. FALSE. 

GO  TO  40 

TRUNCATION  ERROR  LESS  THAN  ACCURC,  RESET  THE  Y  ARRAY  TO 
SET  UP  FOR  THE  NEXT  INTERVAL 

100  XN=XN+H 

DO  110  1=1, N 

1 1  0  Y<  I  )=Yi:  1  )+<  WK<  1 , 3  )+4  .  •WK<  1 , 5  )+H3*WK<  1 , 2  >  >/2  . 

CHECK  FOR  STEP  SIZE  DOUBLING.  DOUBLE  IF  LARGEST  RELATIVE 
ERROR  IS  32  TIMES  LESS  THAN  ACCURC. 

IF<  ,NOT.<TEST  .  GE .  ACCURC/'32.  .OR.  QUIT))  H-H+H 

IF<  .NOT.  QUIT)  GO  TO  20 

RETURN 

THE  VALUE  OF  H  <DEL)  IS  LESS  THAN  THE  SPECIFIED  MINIMUM. 
REPORT  THIS  AND  ERROR  OUT. 


10  CONTINUE 

1  000  FORMAT<'l  H  BELOW  HMINV'O 
DEL=0, 

RETURN 

END 


INTEGRATION  ABORTED') 


RKM00710 
RKM00720 
RKM 00730 
RKM00740 
RKM00750 
RKM00760 
RKM00770 
RKM00780 
RKM00790 
RKM00800 
RKM 0081 0 
RKM00820 
RKM 00830 
RKM00840 
RKM00850 
RKM00860 
RkM00870 
RKM00S80 
RKM 00890 
RKM00900 
RKM0091 0 
RKM 00920 
RKM00930 
RKM00940 
RKM 00950 
RKM00960 
RKM00970 
RKM 00980 
RKM00990 
RKMOl 000 
RKM01 01 0 
RKMOl 020 
RKMOl 030 
RKMOl 040 
RKMOl 050 
RKMOl 060 
RKMOl 070 
RKMOl 080 
RKMOl 090 
RKMOl 1 00 
RKMOl 1 1 0 
RKMOl 120 
RKMOl 130 
RKMOl 140 
RKMOl 150 
RKMOl 160 
RKMOl 170 
RKMOl 180 
RKMOl 190 
RKM01200 
RKM0121 0 
RKM01220 
RKM01230 
RKM01240 
RKM 01 250 
RKM01260 
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PURPOSE 

TO  CONVERT  THE  USER  DEFINED  COORDINATES  OF  THE  CHARGES  TO  THE 
LOCAL  COORDINATE  SYSTEM. 


SUBROUTINE  SETUPS NCHS, 3RCBAS, 3IDE1 , SIDE2, TRHFRM >  SET00010 

DIMENSION  NCHS<  2  SRCBASC  2  ), S1DE1 <  2  >, SIDE2<  2  > , TRNFRM<  2 , 2  ) , ReF<  2  >  SET00020 

COMMON  /ARRAY/OVRLAP,AREA,PERIM.PRJARY,CENDIF  SET00030 

COMMON/M05/'DIFF<2,200)>NC.HTOT,PRSeP<200>,NTOT,NARY,  I  TOT,  SET  00  04  0 

+  COOR<2,200>,TSTAG<200>,DMMY<401 >  SET00050 

COMMON  /lOUHlT/'IOIN, lOOUT , IPHFUN , LOUNIT , NDIRTU , NCL IMT , KSTOR , NPLOTUSET 0 006 0 
I*  Kofi*  lilWstc**!**  SET  0  0  07  0 

SET00080 
SET00090 
3ET001 00 
SET001 1 0 
SET00120 
SETOOf 30 
3ET00140 
SETuOtSO 
SET00160 
SETOol 70 
SET00180 
SET  00 190 
SET00200 
SET0021 0 
SET00220 
SET  00230 
SET 00240 
StT0O25O 
3ET00260 
3ET0027U 

DOUBLY  DIMENSIONED  ARRAY  CONTAINING  THE  CHARGE  COORDINATESSET00280 
"  ‘  SET00290 

SET00300 


INPUTS 

NCHS 


SINGLY  DIMENSIONED  ARRAY  CONTAINING  THE  NUMBER  OF 
CHARGES . 


SRCBAS  -  A  REFERENCE  CHARGE  IN  THE  USER  DEFINED  COORDINATES. 
SIDE1,3IDE2  -  VECTORS  DESCRIBING  THE  BOUNDING  PARRALLELOGRAM . 
TRNFRM  -  COORDINATE  SYSTEM  TRANSFORMATION  MATRIX. 

OUTPUTS  RETURNED  IN  COMMON  /ARRAY/'  AND  /SEPRTN/’ 

DIFF- 


IN  THE  LOCAL  COORDINATE  SYSTEM, 

I  TOT-  TOTAL  NUMBER  OF  CHARGES. 

NCHTOT-  WHEN  NARV»<  OR  2  THE  TOTAL  NUMBER  OF  CHARGES. 
WHEN  NARY=3  IS  SET  =«1  . 


WHEN 


NTOT-  WHEN  HARY=1  OR  2  IS  SET 
NUMBER  OF  CHARGES. 


=1  AND  WHEN  NARy*3  IS  THE  TOTAL 


SUBROUTINES  AND  FUNCTIONS 

UNIT  COMPUTES  THE  UNIT  VECTOR  OF  A  GIVEN  VECTOR 

If  If  K>  Ki «  K>  K>  >*  W  «  K>  If  *  K<  *  K<  f  K>  <*  K<  *  If  K>  K>  Ki  *  K<  K<  If  K>  *  «  K<  K< «  K<  >f  *  Ki  K<  %  K<  If  f  K>  f  K<  <*  K<  Ki  K>  *  Kt  K>  4>  K>  Kc  K<  K>  *  K>  K>  K>  *  Ki  Ki  *  « 

IF<NARY.NE. 1 )GO  TO  4 
HCHTOT=NCHS< 1  )f NCH8< 2 ) 

NTOT-1 
ITOT-NCHTOT 
GO  TO  6 

4  IF<NARY.NE.2)G0  TO  5 
NCHTOT=NCHS< 1  ) 

NT0T=1 
ITOT-NCHTOT 
CO  TO  6 

5  IF<NARY.NE.3>G0  TO  998 
NCHTOT=i 
NTOT=NCHS< 1 > 

ITOT*NTOT 

6  CONTINUE 

DETERMINE  THE  COORDINATE  OF  THE  REFERENCE  CHARGE  IN  THE  INTERNAL 
COORDINATE  SYSTEM 

DO  20  I»1,2 
ReF<  I  )-i0. 0 
DO  10  J-1,2 

REF<  1  )=*REF<  I  >-fTRNFRM<  I ,  J  )*SRCBAS<  J  > 

10  CONTINUE 
20  CONTINUE 
DO  40  1-1,2 
DO  30  J«1 , ITOT 


SET 0031 0 
SET 00320 
3ET00330 
SET00340 
SET00350 
SET00360 
SET00370 
SET00380 
SET00390 
SET00400 
SET004t  0 
SET00420 
SET00430 
SET00440 
SET00450 
SET00460 
SET00470 
SET00480 
SET00490 
SET00500 
SET0051 0 
SET00520 
SET00530 
SET00540 
SET00550 
SET00560 
SET00570 
SET00580 
SET 00590 
SET00600 
3ET0061 0 
8ET00620 
SET00630 
SET00640 
SET0065fi 
SET00660 
SET00670 
SET00680 
3ET00690 
SET00700 
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DIFF< I , J>=0. 0 
30  CONTINUE 
40  CONTINUE 

IF^NrtRY.GT. » )G0  TO  90 
NM=0 

NC1=NCHS< 1 > 

NC2=NCHS<:2) 

COMPUTE  LOCATIONS  OF  CHARGES  FOR  INTERNAL  COORDINATE  SYSTEM  FOR 
UNIFORMLY  DISTRIBUTED  CHARGES. 


J>*SIDEU  J> 


DO  80  M=1,NC2 
DO  70  N-i ,NC1 
NM^NM+1 
DO  60  I=i,2 
DO  50  J=f,2 

DIFF<  I,NM)=-DIFF<  I,NM>+FLOAT<N-1  >*TRNFRM<  I, 

1  +FLOAT<M-1  )*TRNFRM<  I ,  J  )>*.SIDE2<  J  ) 

50  CONTINUE 
60  CONTINUE 
70  CONTINUE 
80  CONTINUE 
GO  TO  S99 
90  CONTINUE 

TRANSFORM  CHARGE  LOCATIONS  TO  LOCAL  COORDINATE  SYSTEM  FOR  RANDOM 
CHARGES . 


NC1*NCHS< 1 > 

DO  120  M=1 .NCI 
DO  11 0  1=1,2 
DO  100  J»1,2 

DIFF<  I,M)«6iFF<  I,M)+TRNFRM<  1,  J>>*COOR<  J,M> 
1 00  CONTINUE 

DIFF< I , M  >=OrFF< I , M  >-R£F< I > 

1 1 0  CONTINUE 
120  CONTINUE 
GO  TO  999 

998  UR1TE< IOOUT,778) 

778  F0RMAT<SX,23H  NARY  OUT  OF  RANGE  > 

999  RETURN 
END 


SET0071 0 
SET00720 
SET00730 
SET00740 
SET00750 
SET00760 
SET00770 
SET00780 
SET  0  0790 
SET00800 
SETuOSI 0 
SET00820 
SET00830 

tET00840 
ET 00350 
SET00860 
SET00870 
SET00880 
SET00890 
SET 009 00 
3ET0091 0 
SET00920 
SET00930 
8ET00940 
SET00950 
SET00960 
SET00970 
SET0G980 
SET00990 
SETOl 000 
SET01010 
SET0t020 
SETOl 030 
SETOl 040 
SET01050 
SETOl 060 
SETOl 070 
SETOl 080 
SETOl 090 
SETOl 1  DO 
SETOl 1 1 0 
SETOl 120 
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SUBkOUTIMc  30URCE<U,NCHRG..DD.MS0Il,D30D> 

III  %  41  lit  4i  %  Id  4t  4i  :4t  )|i  4i  4ii|i  ]|i  %  %  i|ii^  IK  )|i  4i  ^  %  4iiiii|i  41  ifi  41  lie  4i  *  4i  4t  4t  4i  lit  4i  ♦  ♦  4e  )|i  4t  4(  9((  4i  4c  III  4i 

PURPOSE 

TO  CALCUL«TE  EXPLOSIVE  DUST  SOURCE  TERM  FOR  THE 
DIRTRPN  CODE 


INPUT 

bl 

DD 

NSOIL 

DSOD 


THE  WEIGHT  OF  THE  CHARGE  IN  KG-TNT 
DETONATION  DEPTH  IN  METERS 
INTEGER  SOIL  INDEX 
DEPTH  OF  SOD  IN  METERS 


OUTPUT  < RETURNED  IN  COMMON  XPRTINFX  ,  XBUOYCLX  AND  XCARBX 


Ru 

VGRAV 


HPRTS 

RSPH 

DELT 

V2SPH 

XCMSPH 

YCMSPH 

2CMSPH 

XTOP 

YTOP 

RISTIM 


INITIAL  CLOUD  RADIUS  IN  METERS 

SINGLY  DIMENSIONED  ARRAY  CONTAINING  OPTICALLY  WEIGHTED 
AVERAGE  SETTLING  VELOCITIES  FOR  EACH  SIZE  RANGE  IN 
THE  PARTICLE  DISTRIBUTION  <HETERSXSEC> 

THE  NUMBER  OF  SIZE  RANGES  IN  THE  PARTITIONING  OF  THE 
PARTICLE  SIZE  SPECTRUM 

THE  INITIAL  RADIUS  OF  THE  CLOUD  IN  METERS 


SORC001 0 
SORC0020 
SORCOuZO 
SORGO 040 
SORCOuSO 
SORGO 060 
30RC0070 
SORCOOdO 
SORGO 050 
SORC01 00 
SORCOI i 0 
SORC0120 
SORGO) 30 
SORC0140 
SORCOISO 
SORCOI 60 
SORC0170 
SORCOISO 
SORCOI 90 
SORC0200 
SORC  02 1 0 
SORC0220 
SORC 0230 
SORC 0240 
SORG0250 


THE  INITIAL  DIFFERENCE  IN  TEMPERATURE  BETWEEN  THE  CLOUD  SORC0260 


AND  SURROUNDINGS  < DEGREES  KELVIN) 

THE  INITIAL  VERTICAL  VELOCITY  OF  THE  CLOUD  < MXS > 
INITIAL  HORIZONTAL  POSITION  OF  THE  CLOUD  < METERS) 
INITIAL  Y  POSITION  OF  THE  CLOUD  <METERS) 

INITIAL  HEIGHT  OF  THE  CLOUD  <METERS) 

INITIAL  X  POSITION  OF  THE  TOP  OF  THE  CLOUD  < METERS) 
INITIAL  Y  POSITION  OF  THE  TOP  OF  THE  CLOUD  (METERS) 
TIME  LAPSED  SINCE  DETONATION  IN  SECONDS 


RCARB1  PORTION  OF  BUOYANT  CLOUD  WHICH  IS  DIRT  PARTICLES 
RCARB2  PORTION  OF  BUOYANT  CLOUD  WHICH  IS  CARBON  PARTICLES 

CALLED  BY  DUSTCL 
SUBROUTINES  AND  FUNCTIONS 
NONE 


LOGICAL  HORIZ,ONCE 

DIMENSION  CR<  5, 7  ), CD<  5, 7 ) , OWML<  3, 4 ), OUSV<  3, 4 ), PR7TN<  4 ) 

DIMENSION  S<  3  ), BURHTR<  5 ), WTRAT<  5 ) 

COMMON/PRTINFX  RO, VGRAV< 3  ) , NPRTS 

COMMON  /lOUNITXIOIN, lOOUT, IPHFUN, LOUNIT, NDIRTU, NCL IMT, KSTOR , NPLOTUSORC 0520 
C0MM0H7BU0YCL/  RSPH, DELT , VZSPH , XCMSPH, YCMSPH, ZCMSPH , XTOP , YTOP ,  SORC 0530 


SORC0270 
SORC0280 
SORC0290 
SORC0300 
SORC031 0 
SORC 0320 
SORC0330 
SORC 0340 
SORC0350 
SORC0360 
90RC0370 
SORC0380 
30RG0390 
SORCD400 
SORC 041 0 
30RC0420 
30RC0430 
SORC0440 
SORC 0450 
SORC0460 
SORC0470 
SORC04eO 
SORC 0490 
SORC 05 00 
SORC051 0 


*  SPHNS<3), RISTIM 
COMMONXEKTEMP/ZO, ZL, TO, TCI , TC2, TC3 
COMMON/STARS/USTAR, tSTAR, ZSTAR 
COMMON  XWNDPRMX  DXZO, DYXO, D20 , UO , UM, DN, ZINV 
COMMON  XBURST/  ACCEL, TBURST 

COMMON  /GE0MXC0STH2,S1NTH,SINTH2,VISEXT,RTPI,SCRN<2) 
COMMON  XMODEX  HORIZ 

C0MM0HXDISCSXND8CS, TDSC<  20  >, XOSC<  20 ), ZDSC<  20  >, R2DSC<  20  >, 

1  QDSC<20,3> 

C0MM0NXCARBXRCARB1 ,RCARB2 
COMMONXNTALXTNOT , VOLSPH , TNO , CBLEED 

CR  IS  THE  CRATER  RADIUS  INDEXED  BY  COEFFICIENT  AND  SOIL  TYPE 

DATA  CRX.271 ,-.664, .39, ,666,0., .271, -.684, .39, .806,0., 

1  ,366, -.849, .367, .993,0., ,503, -.954, ,45,1 .19,0., 

2  .629,-1 . 08, .264, 1 . 12, 0. , ,629,-1 . 08, .264, 1.12,0,, 


SORC0540 
SORC 0550 
SORC 0560 
SORC 0570 
SORC 0580 
SORC0590 
SORC 06 00 
SORC 061 0 
SORC 0620 
SORC 0630 
SORC 0640 
SORC 0650 
SORC 0660 
SORC 0670 
SORC 0680 
SORC 0690 
SORC0700 
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3  . 806, -i  .28,-.  178.  .652,  O./" 

CD  IS  THE  CRATER  DEPTH  INDEXED  BV  COEFFICIENT  AND  SOIL  TVPE 

DATA  CD7. i 13,-.477, .27, 1 .84,1.05, . 1 34, - . 57 1 , . 343, 2 . 24, 1,31, 

1  . 189, -.84, .447,3.3,2, 1 , .251 ,-1 . 17, .494,4.72,3.34, 

2  . 189, -.84, .447,3.3,2. 1 , .331 ,-l ,49, .579,4.92,3. 13, 

3  .449,-1 .82, .322,4, 1 1 ,2. 02/ 

OUML  IS  THE  OPTICALLY  UEICHTED  HASS  LOADING  COEFFICIENT  INDEXED  BY 
BIN  SIZE  AND  SOIL  TYPE 

DATA  OUHL/2.86E3,2>*0.  ,3.06E3,8»<0./ 

OWSV  IS  THE  OPTICALLY  WEIGHTED  PARTICLE  SETTLING  VELOCITY  i CM/SEC > 
INDEXED  BY  BIN  SIZE  AND  SOIL  TYPE 

DATA  OWSV/12*0./ 

PRTTN  IS  THE  PARTITIONING  RATIO  INDEXED  ON  SOIL  TYPE 
DATA  PRTTN/4*.8/ 

BURHTR  IS  THE  RATIO  OF  BURST  HEIGHT  TO  INITIAL  RADIUS  AND  WTRAT 
IS  THE  FRACTION  OF  THE  TOTAL  HEIGHT  WHICH  IS  EFFECTIVE  IN  THE  CLOUD 

DATA  BURHTR/0, , 4 . , 2 . , 4 . , 3 . /, WTRAT/ . 6, 1 . ,  .8,  1  . ,  .7/ 

RISTM-0, 

XCH3PH=0. 

YCMSPH-0, 

XTOP-0. 

YTOP-0, 

TNO=>TO 

NPRTS*1 

SCARS  IS  THE  OPTICALLY  WEIGHTED  CARBON  PARTICLE  LOADING  COEFFICIENT 
SCARB-270  ’"W 

W3-<  W«WTRAT<  NCHRG  >  . 3333333 

R0>'2. 0*W3 

TAMB-T0+THPCAL<20,ZL,R0>fTSTAR 

DELT«  .  571-TAHB 

RSPH*R0 

ZCHSPH-RO 

BURHT-BURHTR<  NCHRG  ><»R0 
BURVZ-I .3*SQRT<R0) 

TBURST-.  IS-t-RO 

VZSPH-  2,*BURHT/TBURST-BURVZ 
ACCEL-<  BURVZ-VZSPH )/TBURST 
V0LSPH-<4./3.  >»3. 141593fR0>»»3 
TNOT-TOfDELT 
CLAH=DD/H3 

CALCULATE  CRATER  RADIUS  AND  DEPTH 

ONCE-. FALSE. 

IFCNSOIL.EQ. 1 >IDX-4 
IF<NS0IL.EQ.2. >IDX-3 
GO  TO  70 

60  IFCNSOIL.EO. 1 >IDX>6 
IF<NS0IL.EQ.2>IDX-4 
70  CONTINUE 

RC-CR<1,IDX> 

DC-CD< 1 , IDX) 

IF  <CLAN.LT. 1 .E-30)  GO  TO  98 
TERM«1 , 

DO  too  Is2,5 
TERH-TERH-tCLAH 
RC-RC  *  CR<I,IDX>«TERH 
DC-DC  +  CD< I , IDX  >*TERH 


S0RC071 0 
SORC0720 
SORC0730 

tORC0740 
ORC0750 
SORC0760 
80RC0770 
80RC0780 
SORC0790 
SORC0800 
SORC081  0 
SORC0820 
SORC0630 
SORC0840 
SORC0S50 
SORC0860 
30RC0870 
SORC0880 
S0RC0690 
SORC0900 
SORC091 0 
30RC0920 
SORC0930 
SORC0940 
SORC0950 
80RC0960 
30RC0970 
80RC0980 
SORC0990 
SORCI 000 
SORC1010 
SORCI 020 
30RC1 030 
SORCI 040 
SORCI 050 
.SORCI 060 
’SORCI 070 
SORCI 080 
SORCI 090 
SORCI 1 00 
SORCI 1 1 0 
SORCI 120 
SORCI 130 
SORCI 140 
SORCI 150 
SORCI 160 
SORCI 170 
SORCI 180 
SORCI 190 
SORC1200 
SORC1210 
SORCI 220 
SORC1230 
SORCI 240 
SORCI 250 
SORCI 260 
SORC1270 
SORCI 280 
SORCI 290 
SORC1300 
SORCI 310 
SORCI 320 
SORCI 330 
SORCI 340 
SORCI 350 
S0RC1360 
SORCI 370 
SORCI 380 
SORCI 390 
SORCI 400 


( 
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100  CONTINUE 
^3  CONTINUE 

RC=«RC>*W3 

DC=DC*<  W*UTRAT<  NCHRG  >>*■*,  3 
GET  CRATER  VOLUME 
DSDC^DSOD/DC 

VC-<:  2: .  *3 . 1 4 1 592/'3 .  i*RC*RC>*DC‘*'<'  f  .  - 1 . 5*DSDC*t  1  ,  -DSDC^DSDC/S  ,  >  > 
rF<C>SOD.Ge.DC  >VC  =  0,  0 
it-<:0NCE)Gu  TO  110 
0NCE=.TRUE. 

IF<NSOIL.EQ. 1 >VC1-,5*VC 
IF<  HSOIL . EQ . 2  >VC 1  =  , 25f VC 
GO  TO  bO 

110  IF<NSOIL. EQ. 1 )VC=VC1+.5*VC 
IFtNSOIL.EQ." jVC=VC1+.75fVC 

CALCULATE  OPTICALLY  WEIGHTED  PARAMETERS 

NDSC3aMIN0<  1  0,  1FIX<  5  .  •WS/^I  .8  j  > 

CBLEED-=0. 

DO  lul  L=1,HPRTS 
S<L)=OWML<L,NS01L)  *  VC 
VGRAV<  L  )»OUSV<  L , MSOIL  ) 

SPHNS<L)-PRTTN<NSOIL)  ■»  S<  L  ) 

QDSC<1,L  J  1  .-PRTTN<NSOIL  ))  ♦  S<  L  ■>/'FLOAT<  NDSCS  > 
CBLEED=CBLEED+S<  L ) 

101  CONTINUE 
CBLEED=CeLEEO* . 03/W3**3 
RCARBsSCARB^SPHNS< 1 ) 

RCARei  =  1  ./<<  1  .+RCARB) 

RCARB2-RCARB/'<  1  .-•■RCARB) 

SPHNS< 1  )=SPHNS< 1  >+SCARB 
DELH=2 .  -*R0/FLOAT<  NDSCS  > 

2— OELH/2. 

DO  200  I«1, NDSCS 

2-2+DELH 

2DSC< I  )=2 

DO  201  J=1,HPRTS 

GlDSC<  1,  J>-QDSC<  1  ,  J) 

201  CONTINUE 

CON=ALOG<QDSC<  1, 1  )/VISEXT/’DELH/'<2.>»R0  V3. 14159> 

IF<CON.GT. 1 .  )GO  TO  21 0 
D=1  . 

GO  TO  230 
210  D=C.ON 

DO  220  IT=1,5 

D»<  CON- 1  .  ♦ALOG<  D  )  D- 1  > 

220  CONTINUE 

230  R2DSC<  1  )»4.'»RO'*RO/0 

TDSC<  I  >*~OELH*[>ELH/t>/<  D20#2**DN  )/4  . 

S1GZ-DELH»DELH/D 

XDSC<  I  >-U0'*2**Ut1  ■*  TDSC<  I  ) 

200  CONTINUE 
999  RETURN 
END 


S0RC141 0 
S0RC1420 
30RC1430 
SORC1440 
30RC145U 
30RC1460 
SORC1470 
SORCM80 
SORC1490 
SORC1500 
30RC151 0 
30RC1 520 
30RC1 530 
SORC1540 
SORCi550 
SORC1560 
SORC1570 
SORC1580 
SORC1590 
SORC1600 
30RC161 0 
SORC1620 
30RC1 630 
SORC1640 
SORCtSSO 
SORC1660 
SORC 1 670 
SORC1680 
S0RC1690 
SORC 1700 
SDRC171 0 
SORC1720 
SORCi 730 
SORC 1740 
SORCI 750 
SORCI 760 
SORC 1770 
SORC1780 
SORC1790 
SORC1800 
S0RC181 0 
SORC1820 
SORC1830 
SORC1840 
SORCIdSu 
30RC1860 
SORCt870 
SORC1880 
SORC1890 
SORC1900 
SORC1910 
SORC 1920 
SORC 1930 
SORC 1940 
SORC1950 
SORC 1960 
SORC 1970 
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INPUTS 


HEIGHT  AT  WHICH  AMBIENT  TEMPERATURE  AND  TEMPERATURE 
GRADIENT  ARE  DESIRED. 


OUTPUTS 


SUBROUTINE  TEMP< Z, TA, DTAD2  )  TEMP0240 

TEMP001 0 

PURPOSE  TEMP0020 

TO  COMPUTE  THE  AMBIENT  ATMOSPHERIC  POTENTIAL  TEMPERATURE  AND  TEMP0030 
GRADIENT  AT  A  GIVEN  HEIGHT.  TEMP0040 

TEMP0050 

INPUTS  TEMP0060 

TEHP0070 

2  HEIGHT  AT  WHICH  AMBIENT  TEMPERATURE  AND  TEMPERATURE  TEMP0080 

GRADIENT  ARE  DESIRED.  TEMPOOSO 

TEMP  01 00 

OUTPUTS  TEMP0110 

TEMP0120 

TA  AMBIENT  POTENTIAL  TEMPERATURE  TEMP0130 

TEMP0140 

DTADZ  TEMPERATURE  GRADIENT  TEMP0150 

TENP0160 

SUBROUTINES  AND  FUNCTIONS  HEEDED  TEMP0170 

TEHP0180 

TMPCAL  COMPUTES  SCALED  TEMPERATURE  AT  A  GIVEN  HEIGHT  TEMP0190 

TEMP 02 00 

CALLED  BV  DIFEQ,  ATMCAL  TEMP0210 

TEMP 0220 
TEMP  023  0 

C0MM0N7STAR3/USTAR,TSTAR,2STAR  TEMP  0250 

C0MM0N7EKW1ND/'ALP.C.PYF,PXF,UMAT,VMAT  TEMP 0260 

COMMON/'COEF/'AW,  CU,  BW,  DU,  AT,  CT,  BT,  DT  TEMP0270 

COMMOH/EKTEMP/'20,2L,TO,TC1  ,TC2,TC3  TEMP0280 


TA  AMBIENT  POTENTIAL  TEMPERATURE 
DTADZ  TEMPERATURE  GRADIENT 
SUBROUTINES  AND  FUNCTIONS  HEEDED 

TMPCAL  COMPUTES  SCALED  TEMPERATURE  AT  A  GIVEN  HEIGHT 
CALLED  BV  DIFEQ,  ATMCAL 


TEMP0250 
TEMP 0260 
TEMP 0270 
TEMP0280 


COMMON  /lOUHlT/IOIN, lOOUT, IPHFUN, LOUNIT , ND IRTU , NCLIMT , KSTOR , NPLOTUTEMP0290 


S-Zz-ZL 

TA=T3TAR*TMPCAL<  20, 2L , 2 )+T0 
IF<ABS<ZL>.LE. 1 .E03>GO  TO  10 

NEUTRAL  CASE 

DTADZ=TSTAR7<Z042> 

GO  TO  999 

10  IF<2L,GT. 0, 0>GO  TO  15 
UNSTABLE  CASE 

DTADZ=<  TSTAR72  >■*<  1  .  - 1  6  .  ♦<  S  >  )*■•■<  -1  .  /2  .  > 

IF<  S  .  LT  .  -2 . 0  )DTADZ=<  TSTAR/ZL  )♦<  (tT/3  .  ■»<  -ZL/Z  )**(  4  .  /3  .  )  > 
GO  TO  999 

STABLE  CASE 

15  DTAD2-<TSTAR/2L)f<2LA20+2>*1  1  .  ) 

IF<  S . GT . 1 . 5 )DTADZ=BTf TSTAR/ZL 
999  RETURN 
END 


TEMP0300 
TEMP0310 
TEMP  0320 
TEMP 0330 
TEMP 0340 
TEMP  0350 
TEMP0360 
TEMP0370 
TEMP  0380 
TEMP0390 
TEMP0400 
TEMP 041 0 
TEMP 0420 
TEMP0430 
TEMP0440 
TEMP 0450 
TEMP0460 
TEMP0470 
TEMP0480 
TEMP0490 
TEMP 0500 
TEMP 05 10 


r 
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FUNCTION  TMPCAL<20.2L,2> 

Hi 4t  4i  4i  m  >4i «  4t  >|c  4i  4i  4i  *  4i  ♦  ♦  4i  *  4t  *  % 4i  4*  Hi  *  >|i  »  4t  4c  %  ♦  41 4c  %  4c  %  >4i  4(  Hi  ♦  4c  % 


PURPOSE 

TO  CALCULATE  THE  POTENTIAL  TEHPERATURE  SCALED  BV  THE  SCALE 
TEMPERATURE,  T*,  PROM  GIVEN  FRICTION  HEIGHT  AND  MONIN-OBUKHOV 
LENGTH  AT  A  SPECIFIED  HEIGHT. 


INPUTS 

20 

2L 

Z 


THE  FRICTION  HEIGHT  IH  METERS. 

THE  MONIH-OBUKHOV  LENGTH  IN  METERS. 

THE  HEIGHT  AT  WHICH  THE  SCALED  VELOCITV 
IN  METERS 


IS  DESIRED 


RETURNS  SCALED  TEMPERATURE 
CALLED  BY  ATMCAL,  SOURCE  AND  TEMP 
LOGICAL  LOU 

COMMOH/'COEF/AW,CW,BU,DW,AT,CT,BT,DT 


TMP0001 0 
TMP00020 
TMP00030 
TMP00040 
TMP00050 
TMP00060 
TMP00070 
TMP00080 
TMPOOOSO 
TMP001 00 
TMP001 1 0 
TMPOOi SO 
TMP001 30 
TMPOOMO 
TMPOOi 30 
TMP00160 
TMP00170 
TMPOOi SO 
TMPC 01 90 
TMPOOZOO 
TMP002 1 0 
TMP00220 
I MP00230 
TMP00240 
TMP00250 
TMPC 0260 
TMP00270 
TMP00260 


COMMON  /'lOUNIT/^IOIN,  lOOUT,  IPHFUN , LOUNIT ,  NOIRTU ,  NCL IMT ,  KSTOR ,  NPLOTUTMP 0 029 0 


PHIM<Z)-<  1  .-16.  *2  )■**<-.  25) 

PS1H<  3, SO  )=ALOG< ( ( S**2 . -1 .  )/( S**2.*i . ) >♦< <  S0**2 .  +  1 
PSrHS<Z)=-t 1 .*2 
trace  999 


)/( S0**2 . -1 


PHIM 

PSIH 


PHIHS 


THE  SHEAR  OF  MOMENTUM 

THE  UNIVERSAL  FUNCTION  FOR  DEVIATION  FROM  LOGARITHMIC 
POTENTIAL  TEMPERATURE  PROFILE  IN  THE  BOUNDARY  LAYER 
OF  AN  UNSTABLE  ATMOSPHERE 

THE  SAME  AS  PHIH  EXCEPT  FOR  STABLE  ATMOSPHERE 


IF<ABS<2L).LE. 1 .E3)G0  TO  100 
TMPCAL»ALOG< i .+27Z0) 

GO  TO  999 
100  CONTINUE 

P=SIGN< 1 . ,ZL) 

LOU= .TRUE . 

3=Z,'ZL 

IFCS.LE. 1 .5.AND.S.GE.-2.  )G0  TO  10 
S-AMINt<S, 1.5) 

S=AMAX1<S,-2.  ) 

LOU>:.  FALSE. 

10  CONTINUE 

IF<P)120,  130,  130 
120  S»1 ./PHIM<S) 

S1-Z0,^2L 
SO-1 ./PHIMCSI > 

TMPCAL-PSIH<S,SO> 

FIND  CONSTANTS  FOR  MATCHING  IN  UNSTABLE  CASE  AT  Z/ZL— 2. 


130 


S2— 2. 

AT— S.-XC  1  .-16.*S2)>*>X-1  ./2. 
CT—  1  .  ^AT^C  -S2  >■•■•<  - 1  .  /'3 .  ) 

GO  TO  52 
CONTINUE 
PQTkPCTMQ/  ^ 

TMPCAL-ALOG<  1  ,  ♦8*ZL/'20  )-PSI 


>)*<-S2>**<  1.73.) 


FIND  CONSTANTS  FOR  MATCHING  IN  STABLE  CASE  AT  Z/ZL-t.S 


TMP00300 
>>>TMP0031 0 
TMPC 0320 
TMP00330 
TMP00340 
TMP00350 
TMP00360 
TMPi)0370 
TMP00380 
TMP00390 
TMP00400 
TMP0041 0 
TMP00420 
TMP00430 
TMP00440 
TMPUU450 
TMP00460 
TMP00470 
TMP00480 
TMP00490 
TMP00500 
TMP0051 0 
TMP00520 
TMPu0530 
TMP00540 
TMP00550 
TMP00560 
TMP00570 
TMP005S0 
TMP00590 
TMP00600 
TMP0061 0 
TMP 00620 
TMP00630 
TMP 00640 
TMP00650 
TMP00660 
TMP 00670 
TMP 00680 
TMP00690 
TMP00700 
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1 


c 


S2»l .5 

BT*1  ./■<Z0<^2L+S2>+1 1  . 

DT=-1  .♦BT-*>S2 

52  continue 
IF<LOW>GO  TO  999 
IF<P>53,53>54 

53  TMPCAL«TMPCAL+CT+AT*<-ZL/2  )■*■»<  1  ./’3.  ) 
GO  TO  999 

54  TMPCAL-TMPCAL+DT+BT-fcZ/ZL 
999  RETURN 

END 


THP0071 0 
TMP00720 
TMP00730 
TMP00740 
TMP00750 
TMP00760 
THP00770 
TMPC 0780 
TMP00790 
TMP00800 
THP00810 
TI1P00820 


00000000000000000000000000000000000000000000000000 


SUBROUTINE  TRAP<  TRSk , TRUK, TRSP , H, S IGU, SICO, TIME , SKT, UhK , SPH  ) 
THIS  SUBROUTINE  PERFORMS  R  TRRPE20ID  INTEGRATION 
INPUTS 

TRSK  -  ESTIMATE  TO  THE  CLOSEST  POINT  ALONG  THE  LINE  OF  SIGHT 
TO  THE  CENTER  OF  THE  SKIRT 

TRUK  -  ESTIMATE  TO  THE  CLOSEST  POINT  ALONG  THE  LINE  OF  SIGHT 
TO  THE  CENTER  OF  THE  WAKE 

TRSP  -  ESTIMATE  TO  THE  CLOSEST  POINT  ALONG  THE  LINE  OF  SIGHT 
TO  THE  CENTER  OF  THE  SPHERE 

H  -  INTEGRATION  STEP  SI2E  THROUGH  THE  SKIRT 

Slew  -  INTEGRATION  STEP  SI2E  THROUGH  THE  WAKE 

SIGO  -  INTEGRATION  STEP  SI2E  THROUGH  THE  SPHERE 

TIME  -  TIME  TRANSMITTANCE  IS  DESIRED 

ALL  OTHER  NEEDE  INFORMATION  IS  PASSED  VIA  COMMON  BLOCKS 


OUTPUTS 

SKT  -  CONTRIBUTION  TO  THE  CONCENTRATION  ALONG  THE  LINE  OF 
SIGHT  FROM  THE  SKIRT 

WAK  -  CONTRIBUTION  TO  THE  CONCENTRATION  ALONG  THE  LINE  OF 
SIGHT  FROM  THE  WAKE  ONCE  THE  BUOYANT  SPHERE  HAS 
CONVERTED  TO  THE  WIND  MODEL 

SPH  -  CONTRIBUTION  TO  THE  CONCENTRATION  ALONG  THE  LINE  OF 
SIGHT  FROM  THE  SPHERE  ONCE  IT  HAS  CONVERTED  TO  THE 
WIND  MODEL 

FUNCTIONS  NEEDED 

CUIND  -  USED  TO  FIND  THE  CONCENTRATION  AT  A  SPECIFIED  POINT 
<X,Y,Z)  ALONG  THE  LINE  OF  SIGHT  DUE  TO  THE  SKIRT 

eWAKE  -  USED  TO  FIND  THE  CONCENTRATION  AT  A  SPECIFIED  POINT 
<X,Y,2>  ALONG  THE  LINE  OF  SIGHT  DUE  TO  THE  WAKE 

eSPHER  -  USED  TO  FIND  THE  CONCENTRATION  AT  A  SPECIFIED  POINT 
<X,Y,Z)  ALONG  THE  LINE  OF  SIGHT  DUE  TO  THE  SPHERE 


4i  41 «« I*  DC « in  sf  %  i|i  *  I*  4i  **  Hi  * ’ll  iX  <•<  >K  <!■>•<  IC  4< «  >•> ’ll  >X  >•>  4> « If  ^  K  **  K  %  4<  %  III  *  <0 

REAL  KX^KZ 

LOGICAL  SWITCH, CHANGE, ONCE 

DIMENSION  OWF<  5, 2  >, OWFC<  5  )  , TRSK<  3 ). TRWK<  3  >, TPSP<  3  > 
COMMON/LOS/TR<  3  >, RE<  3  >, U<  3 ) 

COMMON/ACLKCWINDS, CWINDC, eWINOW 
COMMON/CARB/RCARBI ,RCARB2 

COMMON/TRAH/VTR, KZ, KX , TTR, XTR, ZTR , QPUFF<  3 ), SWI TCH, CHANGE 

COMMON/SIGKSIG02,SICC 

COMMOH/POINTSKXNORM, D0T1 , 00T2,  D0T3 

DATA  0WFK1 ., .93, .52, . 44 , 2 . E-03 , 1 . , 1 , , 1 . , 1 . , 4 . E- 03K 

DATA  OWFCKI . , .95, .5, .2, 1 .E-03/ 

Tl-TIME 
SKT- 0.0 
WAK-O. 0 
SPH-0. 0 
SUM=0. 0 
SUM1-0.0 
SUM2-0.0 
IND-20 


TRP0051 0 
TRP0001 0 
TRP00020 
TRP00030 
TkPu0040 
TRP00050 
TRPOOOSO 
TRP00070 
TRPOOOaO 
TRP00090 
TftPOOl 00 
TRPOOl 1 0 
TRP00120 
TRPOOl 30 
TKP00i40 
TRP00150 
TRPOOIbO 
TRP00170 
TRP00180 
TRPC0190 
TRP00200 
TRP0021 0 
TkP00220 
TRP0U230 
TRP 00240 
TRP00250 
TRP00260 
TRP00270 
TRP00280 
TRP00290 
TRP00300 
TRP0031 0 
TRP00320 
TRP00330 
TRP00340 
TRP00350 
TRP00360 
TRP00370 
TRP003S0 
TRP00390 
TRP 004 00 
TRP004t  0 
TRP00420 
TRP00430 
TRP00440 
TRP00450 
TRP00460 
TRP00470 
TRP00480 
TRP00490 
TRP00500 
TRP00520 
TRP00530 
TRF00540 
TRP00550 
TRP00560 
TRP00570 
TRP00580 
TRP00590 
TRP00600 
TRF0061 0 
TRP00620 
TRP00630 
TRP00640 
TRP00650 
TRP00660 
TRP00670 
TRP00680 
TRP00690 
TRP00700 
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c 

c 

c 


c 

c 

c 

c 

c 


c 

c 

c 

c 

c 


OHCE=».  FALSE. 

FP=0, 0 
F=0. 0 
J=i> 

DO  10  I«1,IND 
Xl=HfFLOAT< 1-1 ) 

DI5T=D0T1+XI 

IF<  C)IST,GT.XNORM)GO  TO  10 
IF< DI5T . LT . 0 . 0 >GO  TO  10 
X=TRSK< 1  )+XI*lK  1  ) 

V=TRSK<  2  )+Xi*U<  2  ) 

2fTRSK<3i+XI*U<3) 

ACL=CW1ND«:X.  V,2,T1  > 

F  =  ACL 

CHECK  TO  SEE  IF  THE  CONTRIBUTION  IS  NEGLIGABLE 

IFC  .  NOT . ONCE >hCL1*hCL 
It-<  ACL  1  .  LT  ,  1  .  E-1  0  jGO  TO  11 
PER= , ul fACL 1 
ONCE= , TRUE , 

I R^ACL.LT, PER >GO  TO  11 
IF'i  J  .  LE  ,  i  >GO  TO  10 
SUM=SUM+FP+F 
to  CONTINUE 
11  CONTINUE 

IF<<TIME-TTR).LT. 1 .E-20>GO  TO  31 


COMPUTE  THE  CONTRIBUTION  TO  CL  FROM  THE  SPHERE 
INTEGRATION  ONLV  AFTER  THE  BUOYANT  FIREBALL  HAS 
MODEL 

OHC:E=.  FALSE. 

FP  =  0  .  0 
F-0,  0 

jsfi 

DO  2  0  I  *  1 , I ND 
XI=S  IG0’*FLOAT<  1-1  ) 

DIST=D0T3+XI 

IF<;t)IST.GT,XNORM)GO  TO  2  0 
IF<DIST.LT. 0. 0)GO  TO  20 
.X=TRSP<  1  )+XI*U<  t  ) 

Y=TR3P<2)+XI-*U<2) 

2*TRSP<3)+XI*U<3) 

FP=F 

ACL=CSPHER<X,Y,2,TI> 

F=ACL 

IF< , NOT. ONCE  )ACL1=ACL 
IF<ACL1 .LT, 1 .E-05>GO  TO  21 
PER=, 01*ACL1 
ONCE- . TRUE . 

J- J+1 

IF< ACL.LT,PER)CO  TO  21 
IF<  J.LE. 1 >GO  TO  20 
SUM1-SUM1+FP+F 

20  CONTINUE 

21  CONTINUE 

COMPUTE  CONTRIBUTION  TO  CL  FROM  THE  WAKE  AFTER 
HAS  CONVERTED  TO  THE  WIND  MODEL  USING  TRAPEZOID 
SIZE  SIGW. 

ONCE-. FALSE. 

FP-0. 0 
F-0. 0 
J-0 

DO  30  1-1, IND 
XI-SIGW*FLOAT< 1-1 > 


USING  A  TRAPEZOID 
CONVERTED  TO  THE 


TRP0071 0 
TRP00720 
TRP00730 
TRP00740 
TRP00750 
TRP00760 
TRP0077U 
TRP 00780 
TRP00790 
TRP00800 
TRPOuSI 0 
TRP00820 
TRP00830 
TRP00S40 
TRP00350 
TRP00860 
TRP00370 
TRP00S80 
TRP00S90 
TRP009u0 
TRP009i 0 
TRP00920 
TRPu0930 
TRP 00940 
TRP 00950 
TRP 00960 
TRPu0970 
TRP 00980 
TRP00990 
TRPOl 000 
TRPOl 01 0 
WINDTRP01 020 
TRPOl 030 
TRPOl 040 
TRPOl 050 
TRPOl 060 
TRPOl 070 
TRPOl 080 
TRPOl 090 
TRPOl 1 00 
TRPOl t 1 0 
TRPOl 120 
TRPOl 130 
TRPOl 140 
TRPOl 150 
TRPOl 160 
TRPOl 1 70 
TRPOl 180 
TRPOl 190 
TRP0t200 
TRP0121 0 
TRP01220 
TRPOl 230 
TRP 01 240 
TRP01250 
TRP 01 260 
TRP01270 
TRP01280 
TRP01290 
TRP01300 
THE  BUOYANT  FIREBALL  TRPOl 310 
INTEGRATION  WITH  STEPTRP01320 

TRP01330 
TRP0t340 
TRP01350 
TRP01360 
TRP01370 
TRP01380 
TRP01390 
TRPOl 4 00 


f 


£01 


DI5T=00T2+XI 

TRP0141 0 

IFCOrST.GT.XNORMJGO  TO  30 

TRP01420 

IF< OIST . LT , 0 . 0 >Gu  TO  30 

TRP01430 

X=TRUIK<  1  >+XI*U<  1  > 

TRP01440 

V=TRUk<2>+XI>».U<2> 

TRP01450 

2=TRUK<3>+XI*U<3> 

TRP01460 

FP=F 

TRP01470 

hCL=CWAKE<X, Y.Z.TI > 

TRP01480 

F=hCL 

TRP01490 

IF<  .NOT. ONCE >hCL1=hCL 

TRP01500 

IFchCLI .LT. 1 .E-05iGO  TO  31 

TRP0151 0 

PtR= . 01 *ACL 1 

TRP01520 

ONCE= . TRUE . 

TRP0f530 

J=  J+1 

TRP01540 

IF< ACL . LT . PER >Gu  TO  31 

TRPOl 550 

IFC  J.LE. 1 >GO  TO  30 

TRP01560 

SiJM2“SUM2+FP+F 

TRP01570 

CONTINUE 

TRP015S0 

CONTINUE 

TRP01390 

SKT=<  AeS<:H>^2.  )*SLIM 

TRP01600 

UhK=<  hBS<  SiGw  j/Z  .  >>fSUM2 

TRPOl 61 0 

SPH=<  ABS<  S  IGO  :V2  .  >*SLIM1 

TRP01620 

Rh 1  URN 

TRP0i630 

END 

TRP0f640 
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SUBkOuTIHE  TRNChL< TRH , REC , time, TkHLOS >  TRlu0520 

TRL0001 0 

CONTROL IHG  ROUTINE  FOR  CALCULATING  TRANSMITTANCES  FOR  CHARGE  TRL0u020 

DISTRIBUTION  TYPES  1  AND  2  TRL00030 

TRL0UO40 

INPUTS  TRL00050 

TRL00060 

TRN  -  TRANSMITTER  COORDINATES  IN  THE  LOCAL  COORDINATE  SYSTEM  TRL00070 

TRLOuObO 

REC  -  RECEIVER  COORDINATES  IN  THE  LOCAL  COORDINATE  SYSTEM  TRL00090 

TRLOul 00 

TIME  -  TIME  AFTER  THE  DETOATION  AT  WHICH  A  TRANSMITTANCE  IS  DESIRED  TRLOOIIO 

ALL  OTHER  NECESSARY  INPUTS  ARE  PASSED  IN  COMMON  BLOCKS  TRL00130 

TRLOOi 40 
TRL001 50 

OUTPUT  TRLOOIbO 

TRL00170 

TRHLOS  -  TRANSMITTANCE  ALONG  THE  SPECIFIED  LINt  OF  SIGHT  TRlOOISO 

TRLOOI so 

SUBROUiINES  HEEDED  TRL00200 

TRLC021 0 

AVRC  -  FINDS  THE  AVERAGE  OF  THE  MOMENTS  FOR  THE  DISCS  TRL 00220 

TRL 00230 

VSUM  -  ADDS  TWO  VECTORS  TRL 00240 

TRL00250 

UNIT  -  DETERMINE  A  UNIT  VECTOR  TKL002b0 

TRL00270 

TRHCLD-  DETERMINE  THE  LENGTH  OF  THE  INTERSECTION  OF  THE  LINE  OF  TRL00280 
SIGHT  WITH  THE  WAKE  AND  SPHERE  TRL00290 

TRL00300 

TRAP  -  DOES  A  TRAPAZOIDAL  INTEGRATION  THROUGH  SKIRT  WAKE  AND  S  TRL00310 
SPHERE  FOR  N0N-H0RI20HTAL  LINES  OF  SIGHT  TRL00320 

TRL00330 

TRNCHK-  CHECKS  TO  SEE  IF  THE  OBSCURATION  IS  SUCH  THAT  THE  TRL00340 

TRANSMITTANCE  IS  LESS  THAN  A  SPECIFIED  VALUE  TRL00350 

TRLOO360 

TRL00370 

FUNCTIONS  NEEDED  TRL00380 

TRL00390 

DOTPRD  -  FINDS  THE  DOTPRODUCT  OF  TWO  VECTORS  TRL00400 

TRL 0041 0 

CWIND  -  FINDS  THE  CONCENTRATION  ALONG  A  SPECIFIED  HORIZONTAL  TRL00420 

LINE  OF  SIGHT  OR  DETERMINES  THE  CONCENTRATION  AT  SOME  TRC00430 
POINT  ALONG  THE  LINE  OF  SIGHT  FROM  THE  SKIRT  TRL0C:440 

TRL 00450 

CWAKE  -  SAME  AS  CWIND  EXCEPT  FOR  WAKE  TRL00460 

TRL00470 

CSPHER  -  SAME  AS  CWIND  EXCEPT  FOR  BUOYANT  SPHERE  TRL00480 

TRL 00490 

TRL 0051 0 

REAL  KZ  KX  TRLu0550 

DIMENSION  TRN<3),REC<3),0WF<5,2>,0WFC<5>,TEMP<2>  TRL00540 

DIMENSION  DIR<2>,  XW<3>,XS(3>  TRL00550 

DIMENSION  TRSK<3),TRWK<3),TRSP<3)  TRL00560 

LOGICAL  HORIZ, SWITCH, CHANGE, TEST, SKIP  TRL00570 

COMMON  /lOUNIT/IOIN, lOOUT, IPHFUN, LOUNIT, HDIRTU , NCLI MT , KSTOR , HPLOTUTRL 0059 0 
COMMON/^CARB/RCARBI  ,RCARB2  TRL00590 

C0MM0N,''BU0YCL7RSPH,DELT,VZ,XCM,  YCM,ZC«,XTOP,  YT0P,SPHHS<3>,RISTIM  TRL 006 00 
COMMON/M057DIFF<2,200),NCHTOT,PRSEP<200>,NTOT,NARY, ITOT,  TRL 0061 0 

*  DMn<600>,DnMY<401 >  TRL00620 

C0MM0N7GE0M7C0STH2 , S I NTH , S INTH2 , V I SEXT , RTP I , SCRN<  2  >  TRL  00630 

C0MM0N7M0DE7H0RIZ  TRL00640 

COMMONZTRAN/VTR,KZ,KX,TTR,XTR,ZTR,QPUFF< 3 >. SWITCH, CHANGE  TRL 00650 

COMMON/ ACL/CU I NDS , CW INDC , CU I NOW  TRL  0  066  0 

COMMON/LOS/T<  3>,R<3),U<3)  TRL 00670 

COMnON/SIG/SIG02,SIGC  TRL00680 

COMMON/CHARGE/NCHG  TRL00690 

C0MM0N/P01NT8/XN0RM,D0T1 .D0T2,D0T3  TRL00700 


CONTROL ING  ROUTINE  FOR  CALCULATING  TRANSMITTANCES  FOR  CHARGE 
DISTRIBUTION  TYPES  1  AND  2 


INPUTS 


-  TRANSMITTER  COORDINATES  IN  THE  LOCAL  COORDINATE  SYSTEM 

-  RECEIVER  COORDINATES  IN  THE  LOCAL  COORDINATE  SYSTEM 


ALL  OTHER  NECESSARY  INPUTS  ARE  PASSED  IN  COMMON  BLOCKS 
OUTPUT 

TRHLOS  -  TRANSMITTANCE  ALONG  THE  SPECIFIED  LINE  OF  SIGHT 
SUBROUTINES  HEEDED 

AVRC  -  FINDS  THE  AVERAGE  OF  THE  MOMENTS  FOR  THE  DISCS 
VSUM  -  ADDS  TWO  VECTORS 


TRHCLD- 


-  DETERMINE  A  UNIT  VECTOR 

DETERMINE  THE  LENGTH  OF  THE  INTERSECTION  OF  THE  LINE  OF 
SIGHT  WITH  THE  WAKE  AND  SPHERE 


TRAP  -  DOES  A  TRAPAZOIDAL  INTEGRATION  THROUGH  SKIRT  WAKE  AND  S 
SPHERE  FOR  NON-HORIZONTAL  LINES  OF  SIGHT 

TRHCHK-  CHECKS  TO  SEE  IF  THE  OBSCURATION  IS  SUCH  THAT  THE 
TRANSMITTANCE  IS  LESS  THAN  A  SPECIFIED  VALUE 

FUNCTIONS  NEEDED 

DOTPRD  -  FINDS  THE  DOTPRODUCT  OF  TWO  VECTORS 


Ci.l  I ND  - 


FINDS  THE  CONCENTRATION  ALONG  A  SPECIFIED  HORIZONTAL 
LINE  OF  SIGHT  OR  DETERMINES  THE  CONCENTRATION  AT  SOME 
POINT  ALONG  THE  LINE  OF  SIGHT  FROM  THE  SKIRT 


CWAKE  -  SAME  AS  CWIND  EXCEPT  FOR  WAKE 

CSPHER  -  SAME  AS  CWIND  EXCEPT  FOR  BUOYANT  SPHERE 


TRL00620 

TRL00630 

TRL00640 

TRL00650 

TRL00660 

TRL00670 

TRL00680 

TRL00690 

TRL00700 


ono  oooo  0'~>or.»o  ooo  oooo  ooo 


COMHON/TR|i:iNNy/THRESH,TEST,NWL,NSOIL 
COMMON/SK I P I T/SK I P 
COMMON, -’EKTEMP/ZO ,  ZL ,  T  u  ,  TC » ,  TC2 ,  TC3 
DATA  0NEI1/-1  ,  (3/ 

DATA  Oii/F/I  .  ,  .93,  .52,  .44,2.E-03,  i  . ,  i  .  ,  1  .  ,  i  .  ,4  .  t-03/ 

DATA  OWFC/1 . , .95, .5, .2, 1 .E-03/ 

PARAMETERIZE  THE  LINE  CONNECTING  THE  TRANSMITTER  AND  RECEIVER 
NCHG=t 

5i<lP=, FALSE. 

TEST=, FALSE. 

HSPH=u . 0 
HWAi<=0 . 0 
ACLSkT=u . 0 
ACLWAK=0 . 0 
ACL3PH=0 . 0 
XNORM=0 , 0 
DO  to  1=1,3 
R<  I >=REC< I  3 
T< 1 >=TRN<  I  ) 

U<  I  :>  =  R<  1  >-T<  I  > 

XNukM=XN0RM+U< I >**2 
1 0  CONTINUE 

XNORM=SQRT < XNORM  > 

U<  1  >=U<  1  )/'SHORM 
Ut  S  J=U<2  j/XNORM 
U<3;>  =  U<3>/XN0RM 

lF<(TIMfc-TTR).LT. 1 .E-20 jGO  TO  14 

IF  THE  BUOYANT  SPHERE  HAS  BECOME  WIND  BLOWN  DETERMINE  THE  CENTER  OF 
MASS  OF  THE  REFERENCE  CHARGE. 

XCM=XTR+VTRh«<  TIME-TTR  ) 

2CM=2TR 

DETERMINE  CENTER  OF  WAKE  FOR  REFERENCE  CHARGE 
14  2X=5. 0 

CALL  AVRG<  ZX, TIME, OTOT, XBAVRG, S1G2X, SIC2Y ) 

XU< 1  )=<XBAVRG+XCM)/2. 

XU<2)=YCMX2. 

Xli)(  3;=';5. 0+2CM)X2. 

IF  THE  DIFFERENCE  BETWEEN  THE  TRANSMITTER  AND  RECEIVER  IS  GREATER 
THAN  1  PERCENT  OF  THE  DISTANCE  BETWEEN  THEM  THEN  THE  LOS  IS 
CONSIDERED  A  SLANT  PATH. 


1  3 


IF(ABS<U<3>>.GT.  .  01  >GO  TO  20 

IF< ABS<TRN< 3  )-REC< 3  )>. LT. 1 .E-06  )GO  TO  9 


COMPUTE  CLOSEST  POINT  ALONG  THE  LOS  TO  OUR  ESTIMATE  OF  THE  CENTER  OF 
THE  WAKE 

DOT=-<  U<  1  >*<  T<  1  )-XW<  1  )  )+U<  2  )*<  T<  2  )-XW<  2  )  )+U<  3  >♦<  T(  3  >-XW(  3  >  >  > 

T<3.t'=T<3>-*-U<3>*D0T 

R<3>=T<3> 

COMPUTE  CONTRIBUTIONS  FOR  A  HORIZONTAL  PATH 

9  HORIZ-.TRUE. 

CALL  VSUM<REC,TRH,ONEM,DIR> 

CALL  UNITCDIR, DIR, RANGE) 

COSTH=DIR< 1 > 

SINTH=DIR<2> 

SrNTH2=SINTH*81NTH 
C0STH2=C0STH»*2 
SCRN< 1 )»S1NTH 
SCRN<  2  >— C03TH 
00  12  J-I,1T0T 


TRL0071 0 
TRL 00720 
TRL00730 
TRL00740 
TRL0u75o 
TRL00760 
TRL00770 
TRL00780 
TRL00790 
TRL00800 
TRL0u81 0 
TRl 00820 
TRLOOS30 
TRL 00840 
TSL00850 
TRL00860 
TRL00870 
TRL 00880 
TRL00890 
TRL00900 
TRL  0091 0 
TRL 00920 
TRl  0  0930 
TRL  0094  0 
TRl00930 
TRL 00960 
TRL0097U 
TRL 00980 
TRL  00990 
TRLOl 000 
TRL 01 01  0 
TRLOl 020 
TRLOl 05O 
TRLOl 040 
TRLOl 050 
TRLOl 060 
TRLOl 070 
TRLOl 080 
TRLOl 090 
TRLOl 1 00 
TRLOl  1  1  0 
TRLOl 120 
TRLOl 130 
TRLOl 140 
TRLOl 150 
TRLOl 160 
TRL01170 
TRLOl 180 
TRLOl 190 
TRL01200 
TRLOl 21 0 
TRLOl 220 
TRL01230 
TRL01240 
TRL01250 
TRL01260 
TRL01270 
TRL01280 
TRLOl 290 
TRL01300 
TRL0131  0 
TRL01320 
TRL01330 
TRLOl 340 
TRL01350 
TRL01360 
TRL01370 
TRL01380 
TRL01390 
TRL01400 
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DO  H  i  =  1 , 2 
TEriP<  I  )  =  DIFF<  I .  J  ) 

11  CONTINUE 

PRSEP<  J  )=DOTPRD<  TEMP , SOPH ) 

12  CONTINUE 

X  =  [>OTPRD<  SCRN.  TRH  ) 

COMPUTE  THE  CuNTR I  PUT  I  ON  FROM  THE  SKIRT  AT  A  HEIGHT  OF  Tt 3 >  WHERE  T< 
IS  THE  HEIGHT  OF  THE  TRANSMITTER  IF  THE  DIFFERENCE  BETWEEN  THE 
TRANSMITTER  AND  RECEIVER  HEIGHTS  IS  SMALL  AND  IS  THE  Z  COMPONENT  OF 
THE  POINT  ON  THE  LINE  CONNECTING  THE  TRHSMITTER  AND  RECEIVER  ..WHICH 
IS  CLOSEST  TO  OUR  ESTIMATE  OF  THE  CENTER  OF  THE  WAKE  OTHERWISE. 

AClSkT  =  CWInD<  .X.,  Y,  TC  3  >,  TIME  > 

IFi;TEST  )GO  TO  9SS 

TEST  IS  M  luCIChL  VARIABLE  RETURNED  IN  COMMONXTkANNYX  FROM  SUBROUTIN 
TRNCHK  WHICH  IS  ChlLED  BS  CWIND;  CWAKE,  CSPHER,  TRNCLD^  AND  TRAP 
EACH  TIME  A  CONTRIBUTION  IS  MADE  TO  THE  OPTICALL  WEIGHTED 
CuNCtNfKAT I  ON  hlONG  THE  OPTICAL  PATH 


TEST= , FALSE . 
=  ,  TRUE , 


TRANSMITTANCE  IS  GREATER  THAN  TRNMIN 
<A  TkANSMI TTANCE  THRtSHOLD). 
TRANSMITTANCE  IS  LESS  THAN  TRNMIN 


IFL  TIME . GT , TTR  )ACLUAK  =  CWAKE< X , Y , T< 3 > , T 1  ME > 
IF<TEST)GO  TO  998 

I  Ft  TIME .GT , TTR  )ACL3PH  =  CSPHER< X. Y . Tt 3 > , T I ME > 

IF':tEST;GO  TO  998 
iF,._r]ME  OT  .  iTR)^'!  TO  50 
C  l',i  i  N  0  S  =  '.J  C  L  ^  t  T 
Ci'i  j  HDI.i!  =  AC  L  WA.K 
C  w  i  t't  C'  C  =  A  f  1.  S  C'  H 

Call  rR^L:'l  ■-NC'RM,  TIME,  ACLWAK,ACLSPH> 

IF, TEST ^00  Tu  993 
G  Cl  T  0  ?  0 


DO  TRAPECCKt-:  INTEGRATION  FOR  SLANT  PATH  IN  BOTH  DIRECTIONS  FROM 
An  tCiirlHlf  or  THE  LOCATION  OF  CENTER  OF  THE  SKIRT  USING  A  STEP  SIZE 
OF  S!G,THt  btOritTRIC  MEAN  OP  THE  AVERAGE  OF  THE  SPREADS  OF  THE  DISCS 
IN  both  TMF  X  hND  Y  DIRECTION .THEN  IF  THE  BUOYANT  SPHERE  HAS 
CONVERTED  '0  THE  WIND  MODEL  DO  THE  SAME  FOR  THE  WAKE  AND  SPHERE 
WITH  THE  PFFR,-,fs.iATE  STfC'  SIZE.  <  CHECK  TO  SEE  IF  SPHERE  HAS 
CONVERTED  TO  ThL  WIND  MODEL  IS  DONE  IN  TRAP.) 

20  HOF  ir--  ,  FALSE  . 

S]GX=i>0RT(:  S1G2X  ) 

SiGv=SORT<  SIGDV ; 

SiG  =  SGlRrt  SIGXk&IGY  > 

CALL  WIN<  2 ,  0,UX,UV  ; 

XSt  I  )  =  TIMEit-UX 
XSt  2  )  =  TIME*UY 
.'tS'  3  ;  =  2 . 0 

FIND  THE  POINTS  ON  THE  LINE  CONNECTING  THE  TRANSMITTER  AND 
RECEIVEP  THATARE  CLuSE3T_T0  OUR  ESTIMATE  OF  THE  CENTER  OF 
THt  SKlRT.UAKt,  AND  SHHtKt . 

Du  48  J=1 , ITOT 
XSK  =  XS<  1  )  +  DIFF< 1  , J  ) 

Y3K  =  XS<  2  )+DIFF<  2, J ) 

ZSK  =  XS<  3  ) 

DOT  1  =-<  U<  1  >*<  T<  1  )-XSK  )+U<  2  >*<  T<  2  )-Y3K  >+U<  3  >♦(:  TC  3  )-ZSK  )  > 

IF<DOT1 ,LT. 0, 0)D0T1=0. 0 
IF<DOT1  ,GT.XNORM)DOT1=XNORM 
XWK=XW< 1  >+DIFF< 1 , J ) 

YUK  =  XW<2)  +  DIFF<2,  J) 

ZWK=XWF  3  ) 

D0T2=-(  U<;  1  )*<  T<  1  )-XWK  >+U<  2  )•*<  T<  2  )-YWK  >+U<  3  >■*<  T<  3  >-ZWK  >  ) 
IF<D0T2,LT. 0, 0)DOT2=0, 0 


TRLOi 4t  0 
TRL01420 
TRLC1430 
TRL0I440 
TRL01450 
TRLOI 460 
TRL014Z0 
3TRL01 480 
TRL01490 
TRL01500 
TRLOI 51 0 
TRL01520 
TklOI 330 
tRlOI 540 
TRLOI 550 
TRL  0 1 56  0 
ETRL  0 1  3 1-  0 
TklOI  5.8  0 
TRL01590 
TRLOI 600 
TRLOI b 1 0 
TRLOI 620 
TRLOI 630 
TRL01640 
TRL  01650 
TRL01660 
TRL01670 
TRL016S0 
TRL 01 690 
TRLOI 700 
TRL 01 71 0 
TRL 01 720 
TRLOi 730 
TRL  0 1 74  0 
TRL01750 
TRLOI 760 
TRLOI 770 
TRL  01 780 
TRLOI 790 
TRL  018  0  0 
TRLOI 81 0 
TRL 01 820 
TRL  01830 
TRL01840 
TRLOI 850 
TRL01860 
TRLOI 870 
TRL01880 
TRL  01890 
TRLOI 900 
TRL0191 0 
TRL 01 920 
TRLOI 930 
TRL01940 
TRLOI 950 
TRLOI 960 
TRLOI 970 
TRL01980 
TRLOI 990 
TRL02000 
TRL0201 0 
TRL02020 
TRL02030 
TRL02040 
TRL02050 
TRL02060 
TRL02070 
TRL02080 
TRL02090 
TRL021 00 
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IF<.  00T2  .  GT  .  XNORM  >D0T2«XN0RH 
XSPaXCM+DIFF<  1  . J) 

YSP=YCN+DIFF<2, 

2SP=ZCM 

D0T3=— <  U<  1  )■»<  T<  1  )-XSP  >+U<  2  )*<  T<  2  >-VSP  )+U<  3  )<*i  T<  3  >-ZSP  >  > 

1F< 0073 .LT.O.O >DOT3»0 . 0 
IF<  00T3 . GT . XNORM  >D0T3=XN0RH 
NCHG= J 

DO  45  II=>i,3 

TRSK< 1 1  )=T< 1 1 >+U< 1 1 )*OOT 1 
TRUK(  1 1  >=T<  1 1  j+U<  1 1  >>»D0T2 
TRSP< 1 1 >=T< 1 1 j+LK  1 1 >*D0T3 

45  CONTINUE 

OIFS=OIFFUS<ZO,2L,2, 0) 

SI G2=SQRT<  2 . fO I FSfT I ME  J 

IF<S1G2,LT,  1  ,  0;)SIGZ=1  .  0 

H=«U<  1  >i-SIGX+U<2;fSIGY+U<3>>*>SIGZ 

IF<TIME,LT,TTft>GO  TO  46 

HSPX=SQftT<  SIG02+2 . •KX*<  TIHE-TTR  > i 

HSPY=HSPX 

HSPZ=SG!ftT<  3IG(i2+2  ,  ■»KZ*<  TIME-TTR  >  ) 

HSPH=<  U< 1  ;#HSF  X+U<  2  >*HSPY+U<  3  >f HSP2 )/2 . 

HyAi<=<HSPH+H)/’2. 

46  CONTINUE 

CALL  TRhP<  TRSk ,  TRUK ,  TRSP ,  H ,  HUAK;  ,  HSPH ,  T IME ,  SkT ,  UAK ,  SPH  > 

ACLSKT«ACLSKT+SKT 

hCLWhK=ACLWAK+Uh(< 

ACL3PH=ACLSPH+SPH 

CALL  TRNCHKt  ACLSKT , ACLUAK, ACL8PH  > 

1F<TEST)G0  TO  998 

IF< TIME.lt. TTR)CO  TO  47 

HSPH=-HSPH 

HUAK=-HUAK 

47  CONTINUE 

CALL  TRAP<  TRSK, TRUK, TRSP,H,HWAK.HSPH> TIME, SKT.UAK, SPH > 

ACLSKT-ACLSKT+SKT 

ACLWAK«ACLUAK+WAK 

ACLSPH»ACLSPH+SPH 

CWINDSaACLSKT 

CWINDW=»ACLWAK 

CWINDS«ACLSPH 

CALL  TRNCHK<  ACLSKT , ACLUAK , ACLSPH  > 

IF<TEST)GO  TO  998 

48  CONTINUE 

IF<TIME.GT.TTR)GO  TO  50 

CALL  TRNCLD<  XNORM, T IME, ACLMAK , ACLSPH > 

IF<TEST?GO  TO  998 
50  CONTINUE 

ACLC«<  ACLWAK+ACLSPH)*<  RCARBJ  ♦OWF<  NWL,  HSOIL  >+RCARB2'»0UFC<  HWL  )  > 
ACLS=ACLSKT*OUF<  NWL , NSOIL ) 

COMPUTE  THE  TRANSMITTANCE  ALONG  THE  LINE  OF  SIGHT 

TRNLOS=EXP< -ACLS-ACLC ) 

GO  TO  999 

998  TRHLOS-0.0 

999  RETURN 
END 


TRL021 10 
TRL02120 
TRL02130 
TRL 02140 
TRL02i5o 
TRL 02160 
TRL02t70 
TRL 02180 
TRL 021 90 
TRL02200 
TRL 0221 0 
TRL 02220 
TRL02230 
TRL 02240 
TRL02250 
TRL 02260 
TRL02270 
TRL 02280 
TRL02290 
TRL02300 
TRL 02 31 0 
TRL 02320 
TRL02330 
TRL 02340 
TRL 02350 
TRL02360 
TRL 02370 
TRL023d0 
TRL02390 
TRL02400 
TRL 0241 0 
TRL 02420 
TRL02430 
TRL 02440 
TRL 02450 
TRL 02460 
TRL 02470 
TRL02480 
TRL02490 
TRL 02500 
TRL 0251 0 
TRL 02520 
TRL02530 
TRL 02540 
TRL 02550 
TRL 02560 
TRL 02570 
TRL 02580 
TRL 02590 
TRL 02600 
TRL0261 0 
TRL 02620 
TRL02630 
TRL02640 
TRL 02650 
TRL 02660 
TRL 02670 
TRL 02680 
TRL 02690 
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SUBROUTINE  TRHCHK<  hCLS , hCLW, hCLC  > 

THIS  IS  «  SUBROUTINE  TO  CHECK  IF  THE  CONCENTRATIONS  ARE  HIGH  ENOUGH 
SO  THAT  THE  TRANSMITTANCE  WILL  BE  BELOW  A  GIVEN  LEVEL. 


INPUTS 

ACLS 

~  CONTRIBUTION  TO  THE 

CONCENTRATION 

ALONG 

THE 

LINE 

OF 

SIGHT 

ACLU 

DUE  TO  THE  SKIRT 

-  CONTRIBUTION  TO  THE 

CONCENTRATION 

ALONG 

THE 

LINE 

OF 

SIGHT 

ACLC 

DUE  TO  THE  WAKE 

-  CONTRIBUTION  TO  THE 

CONCENTRATION 

ALONG 

THE 

LINE 

OF 

SIGHT 

DUE  TO  THE  BUOYANT 

SPHERE 

ALL  OTHER  NECESSARY  INFORMATION  IS  PASSED  VIA  COMMON  BLOCKS 


OUTPUT 

TEST  -  LOGIICAL  VARIABLE  PASSED  IN  COMMON/TRANNY/'  THAT  IS  .TRUE. 
IF  THE  COHCEHTRATIOH  IS  SUCH  THAT  THE  TRANSMITTANCE 
ALONG  THE  LINE  OF  SIGHT  WILL  BE  LESS  THAN  THE  THRESHOLD 
VwLUE  AND  IS  .FALSE.  OTHERWISE 


FUNCTIONS  ant  SUBROUTINE  NEEDED 
NONE 

DIMENSION  0WF<5,2),0WFC<5;) 

LOGICAL  TEST 

C0MM0N,"CARB..'RCARB1  ,RCARB2 

COMMON/TRAHNV/THRESH, TEST, NWL  ,  NSOIL 

DATA  OWF/1  ,  ,  .  93,  .  52,  .  44,2.E-03,  1  . ,  1  .  ,  1  .  ,  1  .  ,4.E-03<' 

DATA  OWFC.^1  .  ,  .95,  ,5,  .2,  1  .E-03/ 

TEST= .FALSE . 

ACL=<  ACLU+ACLC  >■»<,' RCARBf  »oOWFt' NWL,  NSOIL  )+RCARB2*0WFC<’ NWL  .>  > 
ACL  =  ACL  +  ACLS’*‘OWF<  NWL,  NSOIL  > 

IF<  ACL . GT . THRESH  >TEST= . TRUE . 

999  RETURN 

END 


TRK003i u 
TRK0001 0 
TRK00020 
TRK00030 
TRK0004U 
TRK00050 
TRKOOuSO 
TRKOOOFO 
TRKuOOBO 
TRKOOOSO 
TRkOOl 00 
TRKOOI I  0 
TRK  0  012  0 
TRKOOI 30 
TKK00i40 
TRKOOI 50 
TRKOOlbO 
TRK00170 
TRKOOI SO 
TRKOOI 90 
TRK 002 00 
TRK 0021 0 
TRK00220 
TRK00230 
TRK00240 
TRK00250 
TRK00260 
TRK 00270 
TRK 00260 
TRK00290 
TRKOOjOO 
TRK  00.320 
TRK00330 
TRK 00340 
TRK00350 
TRK00360 
TRK00370 
TRK00380 
TRK 00350 
TRK.  0  04  0  0 
TRK0041 0 
TRK00420 
TRK 00430 
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SUBROUTINE  TRHCLIX  XNORM, TIME, ACLWAK, ACLSPH >  TRD00350 

TRDOOOt  0 

ROUTINE  FOR  DETERMINING  CONTRIBUTION  FROM  SPHERE  MND  URKE  TRD00020 

BEFORE  THE  BUOVHNT  SPHERE  HHS  CONVERTED  TO  THE  WIND  MODEL.  TRD00030 

TRD00040 

INPUTS  TR000050 

TRD00060 

XHORM  -DISTANCE  BETWEEN  THE  TRANSMITTER  AND  RECEIVER  TRD00070 

TRDOuOBO 

TIME  -TIME  AT  WHICH  TRANSMITTANCE  IS  DESIRED  TRDOOOSO 

TRDOul 00 

PUTS  TRD00110 

TRDuOi 20 

ACLWAK  -CONTRIBUTION  FROM  WAKE  TO  OPTICALLY  WEIGHTED  CONCENTRATIONTRD001 30 
ALONG  GIVEN  LINE  OF  SIGHT  TkD00140 

TRDOOISO 

ACL3PH  -CONTRIBUTION  FROM  BUOYANT  SPHERE  TO  OPTICALLY  WEIGHTED  TRDOOISO 
CONCENTRATION  ALONG  GIVEN  LINE  OF  SIGHT  TRD00170 

TRDOOISO 

ROUTINES  NEEDED  TRDOOISO 

TRD00200 

AVRG  -COMPUTE  THE  AVERAGE  OF  THE  MOMENTS  FOR  THE  DISCS  TRD00210 

TRD 00220 

WIN  -COMPUTE  THE  WIND  SPEED  AT  A  GIVEN  HEIGHT  TRD00230 

TRD00240 

AMOUNT-COMPUTE  THE  DISTRIBUTION  OF  THE  LOADING  BETWEEN  THE  8UOYANTTRD00250 


OUTPUTS 


-TIME  AT  WHICH  TRANSMl TTANCE  IS  DESIRED 


ALONG  GIVEN  LINE  OF  SIGHT 


ACL3PH  -CONTRIBUTION  FROM  BUOYANT  SPHERE  TO  OPTICALLY  WEIGHTED 
CONCENTRATION  ALONG  GIVEN  LINE  OF  SIGHT 

SUBROUTINES  NEEDED 

AVRG  -COMPUTE  THE  AVERAGE  OF  THE  MOMENTS  FOR  THE  DISCS 
WIN  -COMPUTE  THE  WIND  SPEED  AT  A  GIVEN  HEIGHT 


SPHERE  AND  WAKE. 

COHLEN-COMPUTE  THE  LENGTH  OF  INTERSECTION  OF  N0N-H0RI20NTAL  LINE 
OF  SIGHT  WITH  A  CONICAL  SHAPED  WAKE 

TRNCHK-ROUTINE  TO  CHECK  IF  THE  OBSCURATION  IS  SUCH  THAT  THE 
TRANSMITTANCE  IS  LESS  THAN  A  USET  SPECIFIED  AMOUNT 


TRD002S0 
TRD00270 
TRD 0 0280 
TRD002S0 
TRD00300 
TRD0031 0 
TRD00320 
TRD00330 
TRD00340 
TRD 00360 
TRD00370 
TRD00380 
TRD00390 
TRD00400 
TRD0  04t  0 


LOGICAL  HORIZ.TEST  TR000360 

DIMENSION  CENTER<3>  TRD00370 

COMMON/MODE.-'HORIZ  TRD  00380 

C0MM0N7GE0M/C0STH2, SINTH, SINTH2, VISEKT^RTPl , SCRN<  2  >  TRD00390 

COMMON/BUOVCL/'RSPH,DELT, VZ,XCM,YCn,2CM,XT0P,YT0P,SPHH8<3),RlSTlM  TRD 004 00 
COMMON7PRT1NF7RO, VGRAV<3  ),NPRTS  TRD004t  0 

COMMON.'DISCS/’NDSCS,TDSC<20),XDSC<20>,ZDSC<20>,R2DSC<2  0),ODSC<2  0,3>TRD0  0420 
COMMON7M05/DIFF<2,200),NCHTOT,PRSEP<200),NTOT,NARY, ITOT,  TRD00430 

+  OMM<600),OMMY<401  )  TRD00440 

COMMON  /lOUNlT/IOIN, lOOUT, IPHFUH, LOUNIT , HDIRTU , NCLIMT , KSTOR , HPLOTUTRD 0 0450 
COMMON/LOS/TR<  3  ) , RE<  3  ) , U<  3  )  TRD00460 

COMMON/TRANNY/THRESH,TEST,NWL,NSOIL  TRD00470 

COMMON/ACL/CWINDS,CWINDC,CWINDW  TRD00480 

COMMON  .^C0NST7PI,PI2,PIRA0,TH0PI,T0RRMB,CDEGK  TRD00490 

ACLWAK-0.0  TRD00500 

ACLSPH=0.0  TRDC0510 

TRD00520 

DETERMINE  THE  RADIUS  OF  THE  BASE  OF  THE  CONE  TRD00530 

TRD00540 

ZX»5.0  TRD00550 

CALL  AVRG<ZX,TIME,QT0T,XBAVG,SIG2X,8IG2Y>  TRD00560 

IF<QTOT.LT. 1 .E-10>GO  TO  33  TRD00570 

S1GX-SQRT<SIG2X>  TRD00580 

SIGY»SQRT<SIG2Y)  TRD00590 

RB*SQRT<SIGX*SICY;  TRD00600 

GO  TO  35  TRO006i0 

33  CALL  WIN<5. 0,UW, V>  TRD00620 

XBAVG-UWicTlME  TRD00630 

RB-0.0  TRD00640 

35  VOLWAK-<  PI73 , >♦<  ZCM-5 . 0  >*<  RSPH**2+RSPH*RB+RB**2  >  TRD00650 

VOLSPH=<  4 . /3 . >#PI*RSPH**3  TRD00660 

CALL  AMOUNT<VOLSPH,WAKAL,SPHAL>  TRD 00670 

DO  80  J«1,ITOT  TRD00710 

IF  <VOLWAK.LE. 0. 0)  CO  TO  68  TRD00680 

XB-XBAVG+DIFF< 1 , J>  TRD00720 
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YB-DIFF<2. J> 

XC“XCM+DIFF< 1 , J  ) 

YC=YCM+01FF< 2, J) 

IF<ABS<LI<3)).LE.  ,  01  >G0  TO  110 
2EiOT=5 . 0 

ChLL  C0NLEN<U. TR,2CM,ZB0T.XC, YC,RSPH,RB,XB, YB,XN0RM,PLENWK) 
PCLU  =  PLEt-IUK*UBKPL/VOLIi)AK 
GO  TO  69 
66  hCLU=0.0 
69  CONTINUE 

HCLulHK=AL.LUAk+HCLul 

CALL  TRNCHK<CWlNDS,rtCLWPI<;,BCLSPH:) 

IF<TE3T>G0  TO  999 

DETERMINE  CONTRIBUTION  FROM  SPHERE  FO  P  SLANT  PATH 

CENTERS  1  )=XCM+DIFF< i >  J  >-TR< 1 > 

CEHTER<2)=YCM+DrFF<2. J>-TR<2) 

CEHTER<3>=ZCM-TR<3) 

CLOSE=U<  1  :)^i::ENTER<  1  >+U<  2  >>*CENTER<  2  )+U<  3  >*CEHTER<  3  > 

CON=CENTER<  1  >*>t'2  +  CENTER<  2  )*"t<2+CENTER<  3  )‘»*2-RSPH'*>i<2 

RADIC=CL0SE**2-C0N 

iF< RADIO . LT . 0 . 0 >G0  TO  75 

PNEAR  =  CLOSE-SwRT<  RADIO  > 

ph  ar=cl03E+sqkt<  radio 

PLENSP=AMIN1<PFAR.XN0RM)-AMAX1<PNEAR, 0. 0> 

IF<  PLENSP . LT . 0 . 0  >PLEHSP=0 . 0 

hi:ls=plensp*sphal/volsph 

GO  TO  76 

75  ACLS=0,0 

76  ACLSPH=ACL3PH+ACLS 

GALL  TRNCHKCCWINDS. ACLWAK,ACLSPH> 

IF<TEST)GO  TO  999 
GO  TO  80 


COMPUTE  CONTRIBUTIONS  FOR  SPHERE  AND  WAkE  FOR  A  HORIZONTAL  PATH 

110  IF<TR<3>.GT.2CM+RSPH>G0  TO  999 
XCEN=XCM+DIFF< 1 ,  J> 

YCEN=YCM4DIFF< 2, J> 

IF>;TR<3).LT.ZCM-RSPH)G0  to  130 
RAD  1 US=SQRT<  RSPHf*2-<  TR<  3  >-ZCM  > 

CALL  PATH<  TR,U,XCEN,VCEN, RADIUS, PLENSP) 

IF<  PLENSP . LT . 0 . 0  )PLENSP=C . 0 
HCL3PH=ACLSPH4PLEN3P>t«SPHAL7V0LSPH 
CALL  TRNCHK<  CUlINDS ,  ACLUAK ,  ACLSPH  > 

IF<TEST)GO  TO  999 
130  IF<TR< 3>.GT.ZCM ;GO  TO  999 
IF';TR<3).LE.5. 0>GO  TO  999 
ZETA=<  TR<  3  )-5 . 0 )k<  2CM-5 . 0 ) 

XCEN=ZETA*XCEN+<  1  .  -2ETA  )4<XB 
YCEN=ZETA*YCEH+<  1-2ETA  >’*YB 
RADIUS=«ZETA»RSPH+<  1-2ETA  >i>RB 
CALL  PATH<TR.U,XCEN,YCEN, RADIUS, PLENWK) 

IF<  PLENWK . LT . 0 . 0  )PLENUK=0 . 0 
ACLUAk=ACLWAK+PLENWK'»>WAkAL/VOLWAK 
CALL  TRNCHK<  CWIHDS , ACLWAK, ACLSPH ) 

IF<TEST>GO  TO  999 
80  CONTINUE 
999  RETURN 
END 


TRD 00750 
TRD00740 
TRD007S0 
TRD00760 
TRD00770 
TRD00780 
TRD00790 
TRDOOSOO 
TRD00S1 u 
TRD 00820 
TRD00830 
TRD 00840 
TRD008S0 
TRD 00860 
TRD00870 
TRD00880 
TRD 00890 
TR000900 
TRD0091 0 
TRD 00920 
TRD 00930 
TRD 00940 
TRD 00950 
TRD00960 
TRD00970 
TRD00980 
TRD00990 
TRD01 000 
TRDOl  01  0- 
TRD01 020 
TRDOi 030 
TRDOf  040 
TRDOI 050 
TRDOI 060 
TRDOI 070 
TRDOI 080 
TRDOi 090 
TRDOI 1 00 
TRDOI 1 1 0 
TRDOI 120 
TRDOI 130 
TRDOI 140 
TRDOI 150 
TRDOI 160 
TRDOI 170 
TRDOI 180 
TRDOI 190 
TRD01200 
TRD0121 0 
TR001220 
TRD01230 
TRD01240 
TRD01250 
TRD01260 
TRD01270 
TRD01280 
TRDOI 290 
TRD01300 
TRD0131 0 
TRDOI 320 
TRDOI 330 
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SUBROUTINE  UNIT< R, B, XNORM > 

DIMENSION  R<2),B<2>  _ 

C  »•»  B  IS  THE  NORM  OF  A,  AND  XNORM  IS  THE  MAGNITUDE 
XNORM«SORT<  A<  1  >**2+A<  2  >*>*2  > 

B<  i  >“A<  1  )/'XNORM 
B<  2  >-A<  2  >/'XNORM 
RETURN 
END 


UNIT001 0 
UNIT0020 
UNIT0030 


UNIT0040 

UNITuOSO 


ono  oorioo  ooo  ooooriooriooooooo 


SUBROUTINE  VEHCL<  NmTMOS, 2TMP . THPMES, ZWHD, WNDMES, THWND, PHI , NSOIL , 

1  S 1 LT , NUL . TRNCOR , RECCOR , T I ME , DHDT , V  0 , VEND I R , 

2  VEHSPD, VEHWID, VEHWHT, VEHTYP, NEWRTM, NEWVEH, 

3  TRNLOS,NERR> 

THIS  ROUTINE  CONTROLS  THE  FLOW  OF  THE  CALCULATION  FOR  THE 
VEHICLE  GENERATED  OUST  CLOUD. 

INPUTS 

SEE  DRTRAN  FOR  DETAILS 
OUTPUTS 

TRHLOS  -  TRANSMITTANCE  ALONG  THE  LINE  OF  SIGHT 
NERR  -  ERROR  CODE 

)|i  JK  ;|(  m  >tt  )|c  4c  )|i  «  Kt  Hi  jf(  %  >|i  Id  iK  %  ♦  4(  4i  m  >|t  ♦  Xt  IK  ♦  ♦  ♦  ♦  «  %  ♦  %  in 

DIMENSION  2TMP<2), TMPMES< 2 > . ZUND< 2 WNDHES< 2 > 

DIMENSION  TRNCOR<  3  RECC0R<  3  >, TRN<  3>,REC<  3  >, TRNFRM<  2. 2  >, ORIG<  2  >, 

1  VK2),V0<2),VDIR<2) 

LOGICAL  DHDT, ERR. NEUATM,NEWVEH 
INTEGER  VEHTYP 


VCL00160 
VCL00J70 
VCL00180 
VCL00190 
VCLOOOt  0 
VCL00020 
VCLO0030 
VCL00040 
VCLOuOSO 
VCL00060 
VCLU0070 
VCLOOOBO 
VCLuOOSO 
VCL001 00 
VCLuul 1 0 
VCL00120 
VCLu0130 
VCL00140 
VCL0U150 
VCL00200 
VCL0021 0 
VCL00220 
VCL00230 
VCL00240 


COMMON  /I0UNIT7I0IN, lOOUT, IPHFUN,LOUNIT,HDIRTU,NCLIMT,i<STOR,NPLOTUVCL00250 


C0MM0H,-’GE0M7C0STH2 ,  SINTH ,  SINTH2 ,  VISEXT ,  RTP I ,  SCRN<  2  > 
C0MM0N/WNDPRM/DX2  0 , DYX  0 , D2  0 , U  0 , UM , DN, 21NV 
COMMON  /CONST/Pl ,PI2,PIRAD,TW0PI ,TORRMB,CDEGK 
DATA  RTPI  /I.  772453/’ 

THETAX=THWND*PIRAD 

IF<  .  NOT . NEWATM  )G0  TO  100 

CALL  ATMCAL<NATM0S,2TMP, TMPMES, 2WND, WNDMES, PHI , THETAX, DHDT, ERR > 
IF< .NOT.ERR)GO  TO  100 
NERR=7 
GO  TO  999 
100  CONTINUE 

IF< ■NuT.NEWVEH)GO  TO  S 

CALL  VSRC< VEHSPD, VEHWID, VEHWHT, VEHTYP, NSOIL, SILT  > 

CALL  PREVEH< NSOIL, NWL) 

5  CONTINUE 

COMPUTE  DIRECTION  VECTOR  FOR  THE  VEHICLE  MOTION  FROM  USERS  INPUT 

ANGL=VEHDIR*P1RAD 

VI  <  1  >=«VEHSPD*COS<ANGL) 

V1<:2>=VEHSPD*SIN<  ANGL) 

COMPUTE  THE  ROTATION  TRANSFORMATION  MATRIX  TO  CONVERT  THE  USER 
DEFINED  COORDINATES  INTO  LOCAL  COORDINATES  WITH  THE  X-AXIS  IN 
THE  WIND  DIRECT  ION. 

TRNFRMt  1  ,  1  >=COS<:  THETAX  > 

TRNFRM<  2, 2  )=TRNFRM< 1,1) 

TRNFRM<  1 , 2  )=«SIN<  THETAX  ) 

TRNFRM<2, 1  )=-TRNFRM< 1,2) 

ORIG< 1  )=V0< 1  ) 

OkIG<2)=VO<2> 

COMPUTE  NEW  COORDINATES  BY  MULTIPLING  BY  THE  TRANSFORMATION  MATRIX 

TRH<  3  )«TRNC0R<:  3  ) 

REC<3)=RECC0R<3) 

DO  20  1=1,2 
TRN< I  )«0. 0 
REC< I >-0. 0 
VDIR< I  )=0, 0 
DO  10  J=1,2 

TRN<  I  )-TRN<  I  )-fTRNFRM<  1 ,  J  )•*<  TRNCOR<  J  >-ORIG(  V  )  ) 

REC<  1  )-REC<  I  )+TRHFRM<  1 ,  J  )>»<  RECCOR<  J  )-ORIC<  J  )  > 

VD I  R<  I  )- VD I  R<  I  )+TRNFRM<  1 ,  J  >'*V  K  J  ) 


VCL00260 
VCL00270 
VCL00280 
VCL00290 
VCL00300 
VCL0031 0 
VCL00320 
VCL00330 
VCL00340 
VCL00350 
VCL 00360 
VCL00370 
VCL003S0 
VCL00390 
VCL00400 
VCL0041 0 
VCL 00420 
VCL00430 
VCL00440 
VCL00450 
VCL00460 
VCL00470 
VCL00480 
VCL00490 
VCL00500 
VCL0051 0 
VCL00520 
VCL00530 
VCL00540 
VCL00550 
VCL00560 
VCL0U570 
VCL005S0 
VCL00590 
VCL00600 
VCL006t  0 
VCL00620 
VCL00630 
VCL 00640 
VCL00650 
VCL00660 
VCL00670 
VCL 00680 
VCL00690 
VCL00700 


oooo 


1 0  CONTINUE 
20  CONTINUE 

CALL  VEHTRN  ROUTINE  TO  USE  COMPUTED  QUADRATIC  FITS  TO  CALCULATE 
A  TRANSMITTANCE 

CALL  VEHTRN<  TRH, REC, TIME, VDIR , TRNLOS  > 

999  RETURN 
END 


il 
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SUBftOUT I NE  VEHTftN<  TRN , REC , T I HE , VD IR , TRHLOS  > 

THIS  ROUTINE  PARAMETERIZES  THE  LINE  CONNECTING  THE  TRANSMITTER 
AND  RECEIVER  IN  THE  LOCAL  COORDINATE  SYSTEM  AND  DOES  A  TRAPEZOIDAL 
INTEGRATION  FROM  VEHICLE  TIME=0,0  TO  VEHICLE  TIME-TIME  THE 
TRANSMITTANCE  IS  DESIRED. 


INPUTS 

TRN 

REC 

TIME 

NWL 

NSOIL 

VDIR 

OUTPUT 


THE  COORDINATES  OF  THE  TRANSMITTER  IN  THE  LOCAL  COORDIHATE 
SYSTEM 

THE  COORDINATES  OF  THE  RECEIVER  IN  THE  LOCAL  COORDINATE 
SYSTEM 

THE  PRESENT  TIME  AT  WHICH  A  TRANSMITTANCE  IS  DESIRED 
INTEGER  INDEX  FOR  WAVELENGTH  BEING  USED 
INTEGER  INDEX  FOR  SOIL  TYPE 

VECTOR  INDICATING  THE  DIRECTION  AND  SPEED  OF  THE  VEHICLE 
IN  THE  LOCAL  CuODINATE  SYSTEM 


TRHLOS  -  TRANSMITTANCE  ALONG  THE  LINE  OF  SIGHT  AT  THE  INDICATED 
TIME 

FUNCTIONS  AND  SUBROUTINES  NEEDED 
GRAND  EVALUATES  THE  INTEGRAND 

Ik  I*  4!  >*  K-.  >)i  »>  <t<  >k  *  Ik  Ik  >•<  If  >t<  *  Ik  « I!  >ti  ■•i*  O'*  Ik  >* *>•<»<>•<  <t>  itr  Oi  *»>>•<*  O  <*  Dull 

LOGICAL  TEST 

0 1  MENS  ION  TRN<  3  ) ,  REC<  3  TRC  3  >.  RE<  3  >,  VDIRf  2  >,  OWF<  5, 2  >.  U<  3  > 
C0MM0N,'’M05/DMMMY<  6  04  )- DMM<  600  ). 

+  I COUNT , T  T MES<  25 ) . XC  0<  3 , 25 ) , XC  U  3 , 25  > , RT<  3 , 25 ) , 

•k  RB<3,25>,22<3,25) 

COMMON/TRANNYXTHRESH, TEST, NWL, NSOIL 
DATA  OWFi'i  ,  ,  .  93,  .52,  .44,2  .E-03.  1  .  ,  1  .  ,  1  .  ,  1  .  ,4  .E-03X 
TEST-. FALSE. 

PARAMETERIZE  THE  LINE  CONNECTING  THE  TRANSMITTER  AND  RECEIVER 

XNORM-0. 0 
DO  10  1=1,3 
RE< I >=REC< I > 

TR<  I  >=TRN(:  I  > 

U< I >=RE< I >-TR< 1  ) 

XNORM=XNORM+U< I 

1 0  CONTINUE 
XNORM=SuRT<XNORM> 

U< 1 >=U< 1  >XXNORM 
U<2>=U<2)/'XN0RM 
U<3)=U<3>/'XN0RM 

INCREMENT  VEHICLE  TRAVEL  TIME  AND  CALL  GRAND  TO  COMPUTE  THE  VALUE 
OF  THE  INTEGRAND.  IF  THE  VALUE  OF  THE  VARIABLE  TIME  IS  GREATER 
THAN  THE  MAXIMUM  TIME  THAT  HAS  BEEN  STORED  < APPROX.  373  SEC >  THEN 
ANY  DUST  PRODUCED  MORE  THAN  TIMES<20>  SECONDS  IS  ASSUMED  TO  HAVE 
NO  EFFECT  ON  THE  TRANSMITTANCE. 

IF<T1ME.LE.TIMES< ICOUNT))GO  TO  11 
TIHC  =  TIMES<  ICOUNT)/'400. 

TSTART-TIME-TIMES< ICOUNT ) 

GO  TO  15 

11  TlHC-TIME/'400. 

TSTART-0, 0 


VTN0034O 
VTN0001 0 
VTN00020 
VTNO(i030 
VTN00040 
VTN00050 
VTNOC1O6O 
VTN00U70 
VTNOOuBO 
VTN00090 
VTNOOt  00 
VTH001 1 0 
VTN00120 
VTN00130 
VTN0OI 40 
VTN00150 
VTNOOi 60 
VTN00170 
VTNuOlSu 
VTN00190 
VTNO02OO 
VTN0021 0 
VTN00220 
VTN00230 
VTN0U240 
VTN00250 
VTN00260 
VTN 00270 
VTN 00280 
VTN00290 
VTN00300 
VTN0031 0 
VTNC0320 
VTH00330 
VTN00350 
VTN 00360 
VTN00370 
VTN00380 
VTN00390 
VTN00400 
VTN0041 0 
VTN00420 
VTN00430 
VTN00440 
VTN 00450 
VTN00460 
VTN 004 70 
VTN00480 
VTN00490 
VTN00500 
VTN 0051 0 
VTN00520 
VTN00530 
VTN 00540 
VTN00550 
VTN 00560 
VTN00570 
VTN 00580 
VTN00590 
VTN00600 
VTN 0061 0 
VTN00620 
VTN00630 
VTN00640 
VTN00650 
VTN00660 
VTN00670 
VTN 00680 
VTN0U690 
VTN00700 
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15  SUM^O.O 

DO  50  1-1,401 

TIVEH=TSTART+FLO#iT<I-l  )*T1NC  . 

CALL  GRANOCU. TR,XNORH. TIME, TIVEH, VOIR, VALUE > 
1F<1.EQ.1  .0R.I.Ee.40OG0  TO  20 
SUM-SUrt+VALUE 
GO  TO  40 

20  SUM-SUM+VALUE,'2. 

40  CONTINUE 

SUM1=SUM*T1HC 
ACLUAK-0. 0 
ACLSPH-0. 0 

CALL  TRNCHK<SUM1  ,  ACLUAK:,  ACLSPH> 

1F<TEST>G0  TO  998 
50  CONTINUE 

SUM-SUM-fTlNC 
ACL-OU)F<  NWL,  HSOIL  )fSU« 

TRNLOS=EXPt-ACL> 

GO  TO  999 

998  TRNLOS»=0.0 

999  RETURN 
ENO 


VTH0071 0 
VTN 00720 
VTN00730 
VTN00740 
VTH00750 
VTH007E0 
VTH00770 
VTH00780 
VTH00790 
VTNOOeOO 
VTN0081 0 
VTH00820 
VTN00830 
VTN 00840 
VTN 00850 
VTN 00860 
VTN00870 
VTN00880 
VTN00890 
VTN00900 
VTN0091 0 
VTN 00920 
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ooo  ooo  oriooooorioriooor'oooorioririooorioriorio 


SUBROUTINE  VSRC<  VSPu , VU I D , VUHT , VEHTVP , HSOIL , S ILT  > 

THIS  SUBROUTINE  IHITIhLIZES  THE  OUST  CLOUD  PRODUCED  BY  A  VEHICLE 
INPUTS 

VSPD  -  THE  VELOCITY  OF  THE  VEHICLE 

VWID  -  WIDTH  OF  THE  VEHICLE 

VWHT  -  WEIGHT  OF  THE  VEHICLE  IN  KGS. 

NSOIL  -  SOIL  TYPE 

SILT  -  SILT  CONTENT  OF  THE  SOIL 

OUTPUTS 


VRS0u320 
VRS0001 0 
VRSOOuZO 
VRS00030 
VRS0004U 
VRS00050 
VRS00060 
VRS00070 
VRS00080 
VRS00090 
VRS001 00 
VRSOOi 1 0 
VRS001 20 
VRSOO 1 30 
VRSOOI 40 
VRSOO 1 50 
VRSOOi 60 
VRSOOI 70 


STORED  IN  C0MM0N70ISCS7  AND  COMMOH/PRE^ 

NDSCS  -  NUMBER  OF  DISCS  (FOR  A  VEHICLE  ONLY  ONE > 

TDSC  -  TIME  OF  RELEASE  OF  THE  DISCS 
XDSC  -  X  POSITION  OF  DISC  AT  TINE  OF  RELEASE 
ZDSC  -  HEIGHT  OF  RELEASE  OF  THE  DISC 
R2DSC  -  SQUARE  OF  THE  RADIUS  OF  THE  DISC 

st>  41  >*>li itc  * 4i  >X  1*  .K W >0 4l 4> >* Ki >)■  41  Ki  4I «■  4i >•  4<  >k ■)■>* >k W I* I*  Xi  A* « 4l Hi  «* >«■ 

INTEGER  VEHTYP 

COMMOH/PRT INF7R 0 , VGRAV<  3  > , NPRTS 

COMMON  /I0UNIT7I0IN, lOOUT, IPHFUN, LOUNIT , ND I RTU, NCL I MT 

C0MM0N70ISCS7N0SCS,  TDSC<  2  0  >,  XDSC<  20  >,  ZDSC.<  2  0  >,  R2DSC<  2 

COMMON7WHDPRM/'DX20,OYXO,DZO,UO,UM,DN,21NV 

COMMON/eKTEMP/ZO,ZL,TO,TC1 ,TC2,TC3 

C0MM0N7PRE72,RT2D2 

COMMON/VL/VLOAD 

NDSCS=1 

NPRT5=t 

VGRAV( I >=0.0 

QDSC< 1 . I >=1 . 0 

INITIALIZE  THE  VEHICLE  SOURCE  FOR  WHEELED  VEHICLES 

2DSC< 1  )=VWID/8. 

2=VWID/4 , 

2Z=VWID/'4  . 

DZ»DIFFUS<Z0,2L,2Z> 

DX=DXZ0*DZ 

TDSC(  1  >=-5.4i<VUID*Hi2  )/512./DZ 
TOF=-TDSC< 1 > 

CALL  MOMENTO VGRAV,Z,ZDSC< 1 >, TOF, Q, XBAR, SIGW2, SIGP2 > 
XDSC< 1 >=-XBAR 
A=1  .  0 

B=S1GU2h-SIGP2 

C=4  .  •<  <  SIGW2H.SIGP2  )-<  <  VWIDX3  .  >h.4.4  >  > 

RAD=B>*>*2-A*C 

R20SC< 1 >=-B+SaRT<  RAO  > 

RT2D2=SQRT<2.*DZ> 

INTIALIZE  LOADING  FOR  VEHICLE  <VLOAO  IN  KG/SEO 

20  SILTPC=1  00  .h-SILT 
A=3.8E-9 

IF<VEHTYP.GT. 0>A=t .52E-08 

QaA>*VSPD4iVUHT4iSILTPC 

ALPHA=240. 


vKbUUi Su 
VRSOOtSO 
VRS00200 
VRS0021 0 
vRS 00220 
VRS00230 
VRS00240 
VRS00250 
Vfi:S0u26O 
VkS00270 
VRS00260 
VRS00290 
VRS 003 00 
4i4ii4  4l4l4i4i4i4i4l4l4i  VRS00310 
VRS 00330 
VRS 00340 
,KSTOR,NPLOTUVRS 00350 
0  )  ,  QDSC.<  2  0,3  >VRS  00360 
VRS 003 70 
VRS00380 
VRS 00390 
VRS 004 00 
VRS0041 0 
VRS00420 
VRS004cs0 
VRS00440 
VRS00450 
VRS00460 
VkS00470 
VRS00480 
VRS 00490 
VRS00500 
VRS0051 0 
VRS00520 
VRS 00530 
VRS 00540 
VRSOuSSO 
VRS00560 
VR30u570 
VRS00580 
VRS 00590 
VR300600 
VRS0061 0 
VRS 00620 
VRS00630 
VRS00640 
VR300650 
VRS00660 
VRS00670 
VRS00680 
VRS00690 
VRS00700 


r 
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SUBROUTINE  V3UH< h , B , S , C > 

C  «:«<>*  ciS+S*B°UHERl^A?B?c'ARl  ^VECTORS  AND  S  IS  SCALAR 
DO  14  J=1,2 
14  C<  «J>-A<  Ji+S-t-BC  J) 

RETURN 

END 


vSUOuul 0 
VSU00020 
VSU00030 
VSU00040 
VSU00050 
VSU0U060 
V3Uu0070 


( 


217 


or>oor.»r»or.»riOor*oooooooooon 


SUBROUTINE  UIN<2,U.V) 

COMNON/STARS/USTRR, TSTAR, 2STRR 
COMMON/EKWI NO/ALP , C , PYF , PXF , UHAT , VHAT 
COMMOH/EKTEMP/ZO,ZL,TO,TC1 ,TC2,TC3 
C0MM0N/BU0YCL/Y<8>,SPHNS<3),RISTIH 

41 «  4*  %  4t  )fi  %  4i  4t  ifi  ^  4(  4t  III  4t  ift  <|t  *fc  4r  i|(  4i  %  ♦  4t  4»  4i  4t  4*  %  >4(  9«e  991  %  ill  4i  ill  4(  141 41  %  t|(  :4i 

PURPOSE 

TO  COMPUTE  THE  WIND  SPEED  AT  A  SPECIFIED  HEIGHT 
INPUTS 

2  HEIGHT  AT  WHICH  WIND  SPEEDS  ARE  DESIRED 
OUTPUTS 

U  WIND  SPEED  IN  THE  DIRECTION  OF  THE  GROUND  WIND 

V  WIND  SPEED  PERPENDICULAR  TO  THE  GROUND  WIND 

CALLED  BY  DIFEQ 

SUBROUTINES  AND  FUNCTIONS  NEEDED 

WHDCAL  CALCULATES  SCALED  WIND  SPEED 

4i «  *  iX  1(1  IK  41 4iik  « *  Ik  111  Ik  41 «  41 4i  4i  itc «  «  «  «  41 Hi  Ik  It «  Hi  Ik  m  «  4i  41  4>  Ik  *  %  >*  <•  *  >*•  *  »■  !(•  A  4>  X<  X>  *  ti  4>  <*  4i  4i  m 

IF<Z.GT.23TAR;'G0  TO  too 
U=*USTAR4iWHDCAL<Z0.2L,2) 

V=0-  0 
GO  TO  S99 

1  00  UE=«C4.EXP<-ALPt2)4.C03<:ALP*2>-PYF 
VE=-CtEXP<  -ALP*2  >*.SIH<  ALP*2  >+PXF 
U=UHAT*UE+VHATtVE 
V=-VHAT>*UE+UHAT*VE 
393  RETURN 
END 


UINOOt  00 
UIN00200 
WIN00300 
WIN00400 
WIN00500 
WIN00600 
WIN00700 
WINOOSOO 
WIN00900 
WINOI 000 
UIN01 1 00 
WIN01200 
WINOI 300 
WIN0t400 
WIN01500 
WIN01600 
WINOjZOO 
WINOIdOO 
WINOI 900 
WIN02000 
WINu2i 00 
UIN02200 
UIN0230U 
UIN024G0 
UIN02300 
WIN02600 
WIN02700 
WIN02800 
WIN02900 
WIN03000 
UIN03) 00 
WIND3200 
WIN03300 
WIN03400 
WIN03500 
WIN03S00 
WIN03700 
WIN03800 
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ooo  oon  ooooooo  0000000000000000000000000 


function  UNDChL<20,ZL,2> 


PURPOSE 

TO  CALCULATE  THE  WIND  SPEED,  U/U*,  SCALED  BV  THE  FRICTION 
VELOCITY  FROM  GIVEN  FRICTION  HEIGHT  AND  MONIN-OBUKHOV  LENGTH  AT 
SPECIFIED  HEIGHT. 

INPUTS 

20  THE  FRICTION  HEIGHT  IN  METERS. 

2L  THE  MONIN-OBUKHOV  LENGTH  IN  METERS. 

2  THE  HEIGHT  AT  UHICH  THE  SCALED  VELOCITY  IS  DESIRED 

IN  METERS 

RETURNS  VELOCITY  SCALED  BY  FRICTION  VELOCITY 
CALLED  BY  ATMCAL,WIN  AND  RISE 

******  tK4t^  amt  fit** mm 


LOGICAL  LOU 

COMMON/COEF/’AW,  CW,  BW,  DU,  AT,  CT ,  BT,  DT 

COMMON  /I0UNIT2I0IN, lOOUT, IPHFUN, LOUNI T , ND IRTU , NCLl MT , KSTOR 
PSIM<2,21  )=ALOG<< 1  . -2  )/< 1  .-21  )  >-ALOG< < 1  .+2>/< 1  .+21  > >+ 

$2  .  *<  ATAN<  2  )- ATAN<  2  0) 

PSIMS-:2)=-7.*2 

PHIM<Z)=<  t  .-16.  *2  >♦+•<-.  25) 

PHIM  THE  SHEAR  OF  MOMENTUM 

PSIM  THE  UNIVERSAL  FUNCTION  FOR  THE  DEVIATION  FROM 

LOGARITHMIC  WIND  VELOCITY  BOUNDARY  LAYER  PROFILE 
UNSTABLE  ATMOSPHERE 

PSIMS  THE  SAME  AS  PSIM  FOR  A  STABLE  ATMOSPHERE 

;FcABS<2L).LE, 1 .E3)G0  TO  100 
UNDCAL  =  ALCiG<  1  .+2/20) 

GO  TO  999 
100  CONTINUE 

P=SIGN< 1 . , 2L ) 

LOW=.TRUE. 

S=Z/2L 

IF<S.LE. 1 .5,AN0.S.GE.-2. )G0  TO  10 
S=AMIN1<S, 1.5) 

S=AMAXt<S,-2. ) 

LOU=. FALSE. 

10  CONTINUE 

I+<P)120,130,130 
120  S=1 ,/PHIM<S) 

S1=Z0/2L 
S0=1 ./PHIM<S1 ) 

WNDCAL=PSIM<S,SO) 

DETERMINE  THE  CONSTANTS  FOR  MATCHING  AT  2/ZL=-2. 

S2=-2. 

AW=-3,K<<  1 -1  6.  *<  S2  ))■»>•><-.  25  ))>*<<<-S2  )•>«•<  1  ./3.  >) 

CU=- 1  .  ♦AW*^  -S2  )♦’*'<  - 1  .  /3 ,  ) 

GO  TO  52 
130  CONTINUE 

PSI=PS1MS<S) 

UNDCALaALOC< 1 . +8*ZL/Z0 )-PSI 

FIND  THE  CONSTANTS  FOR  MATCHING  OF  STABLE  PROFILE  AT  2/2L-1.5 


UND0001 0 
**+  UHD00020 

WND00030 
WND00040 
UNDO  0050 
UND00060 
UNDOOuZO 
UND00080 
H  AT  A  UND00090 
UND001 00 
UNDuOl 1 0 
UND001 20 
WNDOOl 30 
UNDOOI 40 
WNDOOl 50 
UNDOOI 60 
UND0U170 
UND001S0 
UNDO  01 90 
UNDO 02 00 
UND0021 0 
UNDO  0220 
UND00230 
UNDO  024  0 
UNDO  0250 
>*+  UND00260 

UNDO 0270 
UNDO  0260 
,NPLOTUWND00290 
UND00300 
UND0031 0 
UND00320 
UND00330 
UNDO  0340 
UNDO  0350 
UNDO  036  0 
IN  AH  WND00370 
UND00380 
UNDO  039  0 
UNDO  04 00 
UND0041 0 
UNDti0420 
UND00430 
UNO 00440 
UND004a0 
WND00460 
UND004('0 
UNDO 04 80 
UND00490 
UNDOOSOO 
UNDO 051 0 
WND00520 
UNDuOSSO 
WND00540 
UNDOOSoO 
UNDO 0560 
WND00570 
UND00580 
WND00590 
WND00600 
UNDO  061 0 
UHD00620 
UND00630 
UNDO  064  0 
WND00650 
UND00660 
UND00670 
WH000680 
UNDO  069  0 
WND00700 
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S2-1  .5 

BU-t  ./'<Z0.^ZL+S2>+7. 

DU=-1 .♦S2*BU 

52  CONTINUE 
IFCLOuDGO  TO  999 
IF<P)53,53,54 

53  UNDCAL=UNDCAL+CU+AU*<-2L/Z  )■*>»<  t  . /3  .  ) 
GO  TO  999 

54  UN0CAL»UNDCALfDU+BU>»Z/'2L 
999  WNDCAL=WNDCAL/'.4 

998  CONTINUE 
RETURN 
END 


UND0071 0 
UND00720 
UND00730 
UND00740 
UND00750 
UH000760 
UNDO 0770 
WND007d0 
UND00790 
UND00800 
UNDOOSt  0 
UNO 00820 


UND00d30 
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00000000000000000000000000000000000000000000000000 


SUBROUTINE  NMMU<FREQGH, ICLMRT, MMTRAN, lERR) 

COMMON  /CONST/PI , P 12, PIRAD, TWOPI , TORRMB, COECK 
COMMON  /’CLYMAT/'TEMP,PRESS,RH,AH,DP,VIS,CLDAMT,CLDHYT, 


COMMON 

COMMON 


r  ir  /  Avwwi  /  «r~nr 

/CEOMET/'PTS<  15),  1GE08W 


PURPOSE:  TO  CALCULATE  THE  EXTINCTION  AND  BACKSCATTER  AT  MILLIMETER 
FREOUENCIES  10  TO  1000  CH2,  DUE  TO 
GASEOUS  ABSORPTION,  FOC< ICE  AND  UATER >  AND 
CLOUD  BULK  ATTENUATION,  RAIN,  SNOW  EXTINCTION. 

•**  INPUT  TO  THE  NMMW  MODULE  IS  PERFORMED  THROUGH  A  CARD  ORDER- 
**  INDEPENDENT  INPUT  TECHNIQUE,  A  FOUR-LETTER  IDENTIFIER  IN  COLS. 

**  1-4  OF  EACH  RECORD  SPECIFIES  THE  TYPE  OF  DATA  BEING  READ  BY  THE 
MODULE.  THE  INPUT  CARDS  MAY  APPEAR  IN  ANY  ORDER  WITH  THE  EXCEPTION 
Hi*  OF  OF  THE  <G0>  END  OF  READ  SENTINEL,  WHICH  MUST  BE  THE  LAST  CARD 
♦*  READ.  ALL  OF  THE  FOLLOWING  CAROS  ARE  READ 
**  <A4,1X,3<E10,4,1X>>  : 


IN  UNDER  THE  FORMAT 


CARD  IDENTIFIER 
VARIABLES  READ  i 


1  PATH 
MMWPTH 


<PATH  LENGTH  < KM > > 


CARD  IDENTIFIER 
VARIABLES  READ 


:  ATMO 
TEMPI 
PRESS  1 
ABSHUM 


***NOTE i 


< TEMPERATURE  < DEC  C>> 

< PRESSURE  <MB>> 

<IF  .GT.  0.  ABSOLUTE 
HUMIDITY  <GM/'M**3>> 

<IF  .LT.  0.  RELATIVE 
HUMIDITY  <X>> 

TEMPI , PRESS  1 , ABSHUM  WILL  BE  PASSED  FROM  CLIMAT  IF 
ICLMAT=1,  IN  THAT  EVENT,  THE  < ATMO )  CARD  IS  NOT  NEEDED, 


LOCAL  VARIABLES 


HMHOOOi 0 
NMM00020 

.  _  .  NMM00030 

FOGPRB,WNDVEL,WNDDIR, IPASCT  NMM00040 

/lOUNIT/’IOIN, lOOUT, IPHFUN , LOUNIT , ND IRTU , NCLIMT , KSTOR , NPLOTUNMMO 005 0 
_ .  NMM00060 

NMM00070 
NMM00080 
NMM00090 
NMM001 00 
NMM001 1 0 
NMM00120 
NMM001 30 
NMM00140 
NMMOCHSO 
NMM00160 
NMM00170 
NMMOOISO 
NMM00190 
NMM00200 
NMM0021 0 
NMM00220 
NMM00230 
NMM00240 
NMM00250 
NMM00260 
NMM00270 
NMM002B0 
HMM0C290 
NMM00300 
NMM0031 u 
NMM00320 
NHM0D330 
NMM00340 
NMM00350 
NMM00360 
NMM00370 
NMM00380 
NMM 00390 
NMM00400 
NMM 0041 0 
NMM 00420 
NMM00430 
NMM00440 
NMM 00450 
NMM 00460 
NMM 004 70 
NMM 00480 
HMM00490 
NMM00500 
NMM0051 0 
NMM00520 
NMM00S30 
NMM00540 
NMM00S50 
NMM 00560 
NMM 005 70 
NMM00580 
NMM00590 
NMM00600 
NMM0061 0 
NMM00620 
NMM00630 
NMM00640 
NMM0065G 
NMM00660 
NMM00670 
NMM00680 
HMM00690 
NMM00700 


CARD  IDENTIFIER 
VARIABLES  READ  : 

1  FOGD 
FOGDEN 

<FOG  DENSITY  < LIQUID  WATER, 
GM7M**3>> 

CARD  IDENTIFIER 
VARIABLES  READ  t 

t  RAIN 
RAINRT 

<RAIH  RATE  < MM/HR >> 

CARD  IDENTIFIER 
VARIABLES  READ  i 

:  SNOW 
SNOWRT 

<SNOW  RATE  <MM/HR>  WATER  EQUIV.) 

CARD  IDENTIFIER 
VARIABLES  READ  ; 

i  GO 

NONE 

(END  OF  READ  SENTINEL) 

MAIN  ROUTINE  CALLS  NMMW.  NMMW  THEN  CALLS 

<1)MMWGS<GAS  ABSORPTION),  <2)MMWFG<FuG  ABSORPTION, BACKSCATTER >, 
<  3  )MMRAN<  RAIN  EXTINCTION, BACKSCATTER ), 

<4)MMSN0<SN0W  EXTINCTION, BACKSCATTER ),  AND  RETURNS  TO  MAIN  NMMW 


REAL  MMWPTH , MMTRAN , MMBSXS 
DIMENSION  DAT<3}, IAL<6) 

DATA  IAL/2HPA  , 2HAT  , 2HF0  ,2HRA  ,2HSN  , 2HG0  / 

lERRi^O 

GASABS=0. 

FOGEXT=0. 

RAINEX=0. 

FOG6S=0, 

RAIN6S=0. 

SHOWBS>0. 

5  READ< IOIN,400>IALFA, IALFA2, < DAT< L >, L-1 , 3 > 

400  F0RMAT<2A2, 1X,3<E1 0.4, 1X)> 

IF<IALFA.EQ.IAL<1 >>  GO  TO  1 0 
1F< lALFA.EQ. IAL<2>>  GO  TO  20 
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IF< lALFA.EQ, IhL<3>)  GO  TO  30  NMM00710 

IF< IALFA.EQ. IAL<4>)  GO  TO  40  NMM00720 

IF< lALFA.EQ. IAL<5))  GO  TO  50  NMH00730 

IF<  Ir^LFA.EQ.  IAL<6>>  GO  TO  60  NHM00740 

URITE<  IOOUT,450>InLFi!),  lnLFA2  NHH00750 

450  FORMAT<  1H0,20X.2A2,22H  IS  AN  INCORRECT  LABEL  //•>  NMM00760 

GO  TO  300  NMt100770 

1 0  HMWPTH=DAT< 1 >  NMH00780 

GO  TO  5  NMM00790 

20  TEMP1»DAT<1>  NHM00800 

PRESSt=DATc2)  NHM00S10 

ABSHLiM=DAT<3)  NMM00820 

GO  TO  5  NNM00830 

3  0  FOGDEN=[>AT<  1  >  NMM00840 

GO  TO  5  NHHOOdSO 

40  RAIMRT=OAT< 1 >  NMH00860 

GO  TO  5  NMM00870 

5  0  SNOWRT>=OAT<  1  )  NMM00880 

GO  TO  5  NMHO088O 

60  CONTINUE  NHH00900 

IF< IGEOSW . NE . 1 >GO  TO  99  NHM00910 

I1MWPTH=SQRT<<PTS<4  )-PTS<  1  >  )*>»2+<  PTS<  5  >-PTS<  2  >  >**2+  NMM00920 

+< P I 3< 6 >-PTS< 3 ) >**2 )  NMM00930 

99  CONTINUE  NMH00940 

IF<ICLMAT.EQ. 1 >  TEHP1=TEMP  NMH00950 

IF<ICLMAT.EQ. 1  )  PRESS1-PRESS  NMH00960 

IF-;  ICLMAT.EO.  1  )  ABSHUM=AH  NHM00970 

URITE< IOOUT,500)  TEMPI , PRESS  1 , ABSHUM,FOGDEN  NHM00980 

UR1TE< IOQUT.600)  RAINRT , SHOWRT . FREQGH , MMUPTH  NMM00990 

C  CHECK  MODEL  INPUTS  FOR  RANGE  OF  VALIDITY.  NMMOIOOO 

IF<PRES31 .GE.500. >  GO  TO  1 00  NMN01010 

lERR^I  NMM01020 

URITE< lOOUT.SOO)  NMM01030 

100  IF<FREQGH.LE. 1  000.  .AND.FREQCH.GE. 10.  )  GO  TO  150  NMM01040 

IERR=1  NMM01050 

yRITE< IOOUT,900)  NMM01060 

150  1F< lERR.EQ. 1 )  GO  TO  300  NMM01070 

C  CHANGE  UNITS  NMM01080 

PRSTOR=PRESS1/’TORRMB  NMM01090 

TEMPDK=TEMP1+COEGK  NMMOtfOO 

C  CALL  INDIVIDUAL  MODULES  FOR  GAS,  FOG/CLOUD,  SHOW,  RAIN  EXTINCTION  NMM01110 

CALL  MMUGSCTEMPDK,PRSTOR,ABSHUM,FRECJGH,GASABS>  HMM01120 

IF<FOGDEN.GT. 1 .E-10)  NMM01130 

♦  CALL  MMWFG<FOGDEN,TEMPDK,FREQGH,FOCEXT,FOGBS>  NMM01140 

IFCRAINRT .GT . 1 .E-1 0)  HMMOIISO 

♦  CALL  MMRAN<RAINRT,TENPDK,FREQGH,2. ,RAINEX,RAINBS>  NMM01160 

IF<SNOURT.GT . 1 .E-1 0)  NMM01170 

♦  CALL  MMSNO<SNOWRT,TEMPDK,FREaGH,SNOWEX,SNOUBS>  NMM01I80 

C  COMPUTE  TRANSMISSION  NMM01190 

T0TEXT=iGASABS-i-F0GEXT-»RAINEX4SN0WEX  NMM01200 

MMBSXS=FOGBS4RAINBS-i-SNOUBS  NMM0121 0 

MMTRAN=EXP< -MMWPTHfTOTEXT  >  NMMO 1 22 0 

C  CHANGE  UNITS  FOR  ABSORPTION/EXTINCTION  FROM  l.-'KM  TO  DB7KM.  NMM01230 

DBKM>4.343  NMM01240 

GASABS^GASABSkDBKM  NMM01250 

F0GEXT>F0GEXT4DBKM  NMM01260 

RAINEX-RAINEX>»DBKM  NMM01270 

SNOWEX-SNOWEX^DBKM  NMMO 1280 

URITE< IOOUT,700>  CASABS, FOCEXT, RAINEX, 3N0UEX, MMTRAN  NMM01290 

WRITE< IOOUT,750>  F0GBS,RAINB8,SN0WBS,HMBSXS  NMM01300 

C  COMPUTATION  COMPLETED  NMM01310 

300  RETURN  NMN01320 

C  NMM01330 

500  FORNAT< lH0,/'//,47X, 12HTEMPERATURE  , 14X,F8.3,  NMN0t340 

4  tOH  DEGREES  C, X, 47X, 9HPRESSURE  ,17X,F8.3,  NMM01350 

4  3H  MB,/, 47X, 17HABSOLUTE  HUMIDITY, 9X,F8. 3,  NMM01360 

4  7H  G/M<*4>3/,47X,  1  1HFOG  DENSITY,  15X,F8. 3,  NMM01370 

4  7H  G/M*>»3>  NMM01380 

600  FORMAT< IN  ,46X,9HRAIN  RATE, 17X,F8.3,6H  HH/HR,/  NMM0t390 

4  ,47X,9HSN0W  RATE, 17X,F8. 3, 6H  MM/HR,/  NNM01400 


I 


+  ♦ 


,47X,9HPREiiUENCV,  17X,E8.3,4H  GHZ7 
,47X,nHPATH  LENGTH,  15X,F8. 3, 3H  KM) 

700  FORMHT< 1H0,46X, t4HGAS  ftBSORPT I  OH, 1  OX , E 1 0 . 4 , 6H  DB/KM,/ 

+  ,47X,15HF0G  EXTINCTION  ,9X,E10.4,6H  OB/KM,/ 

*  ,47X,t6HRAIH  EXTINCTION  ,0X,E1O.4,6H  DB7KM,X 

+  ,47X,16HSN0W  EXTINCTION  ,8X,E10.4,6H  DB/KM,.' 

+  ,47X, J3HTRHNSMISSI0N  ,llX,E10.4/> 

750  FORMRT<1H  ,4BX,15HFOG  BACKSCftTTER , 9X ,  E 1  0 . 4 ,  1  OH  M*’*2/M*>«3,7 

♦  ,47X,16HRRIN  BACKSCPTTER ,  8X ,  E 1  0 . 4,  1  OH  M**2yM*>f3 , 7 

+  ,47X,16HSN0W  BPCKSCATTER ,  8X,  E 1  0 . 4 ,  1  OH  M**2/M>**3,/ 

+  ,47X,  17HT0TAL  BACKSCATTER,  7X,  E 1  0 . 4,  1  OH 

800  FORMAT< tH0,47X,41HPRESSURE  LESS  THAN  500  MB,  GAS  ABSORPTION, 
+  19H  WILL  BE  INACCURATE) 

900  FORMATS  1H0,47X,31HFREC!lJEHCV<t0,  GHZ,  OR  >1  000  GHZ, 

+  42H  CALULATION  WILL  FAIL,  USE  OTHER  FREQUENCY) 

END 


NMM01410 
NMM01420 
NMM01430 
NMM0T440 
NNM0M50 
NMM01460 
NMM01470 
NMM01480 
NMM01490 
NMM0I500 
NMM0151 0 
NMMOI 520 
NMM01530 
NMM01540 
NMMOI 550 
NMM01560 
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FUHCTION  AB<WA,A,CE,B,C) 

AB-A>*EXP<  -ABS<  <  ALOG 1  0<  1  .  E4'*«A/CE  >/'B  >  >f*C  > 

RETURN 

END 


AB  000<0 
AB  00020 
AB  00030 
AB  00040 


FUnuTIOH  DuPtUH,H,CE( , B , C , CE2 , 0 , E, Ce3, F , u  > 

V=  1  .  /'UP 
V2=V*V 

HI=CEi*CEt-V2 

H2aCE2fCE2-V2 

H3=CE3*CE3-V2 

DCiP=SQRT<  H+BfH  1  .><  H 1  >*<H  1  +C*V2  H2>*H2+E‘«‘V2  >+F*H3/<  H3*H3*C*V2  >  > 

RETURN 

END 


DuPOOOt  0 
DOP00020 
DOP00030 
DOPC0040 
DOPOuOSO 
DOP00060 
DOP00070 
DOP00080 
DOPOOOyu 
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SUBROUTINE  INTRP< A, B, T, F, TT, FF, AA, BB, J > 


PURPOSE!  TO  DO  FREQUENCY  AND  TEMPERATURE  INTERPOLATION^ 

DIMENSION  A<9.3).  B<9,3>.  F<9),  T<3;) 

IF<TT.LT.T< 1  >>  TT=T< 1  ) 

DO  i  1  3 

IFCTT.LT.TC  J)>  GO  TO  14 
CONTINUE 
TT=T<3> 

J=3 

CONTINUE 
DO  15  1=2,9 

IF<FF,LT.F< I  )>  GO  TO  16 

CONTINUE 

FF=F< 9  ) 

1=9 

FF=hLOG1 0<  FF  > 

FO=ALOG1 0<  F<  I  j  > 

FI  =ALOG  1  0<F<'  1-1  >> 

FF0=<  FO-FF  ;/■(  FO-Fl  > 

FF1=«;FF-F1  )/'<FO-Fl  > 

TF  0=<  T<  J  >-TT  )/<  T<  J  >-Tt  J- 1  >  ^ 

TF1=<TT-T<  J-1 >)/<T<  J>-T<  J-1  >> 

Hi  l=ALOG1 0<A< 1-1  ,  J-l  >> 

A01=ALOG1 0<A< I, J-1  )) 

A1 0=ALOG1 0<A< I-t ,  J)) 

AOO=ALOG1 0<A< 1,  J>) 

APJ1=A1 1*FF0+A01*FF1 
APJ0=A1 0*FF0+A00*FF1 
AA^APJI^TFO+APJO-cTFI  ^ 

Bl 1=ALOGl 0<B< I-l , J-l  )) 

B1  0=ALOG1 0<B< 1-1 , J)) 

801=ALOG1  0<B<  I,  J-0> 

BOO-ALOG1 0<B< I, J)) 

BPJ1=ei 1*FF0+B01*FF1 

BPJ0=B1 0*FF0+B00*FF1 

B8=BPJ1*TF0+BPJ0*TF1 

AA=l  0 .  >t"fAA 

BB  =  1  0 .  >*>>oBB 

RETURN 

END 


INT0001 0 
INT00020 
■INT00030 
INT00040 
INT00050 
INT00060 
INT00070 
INT00080 
INTuuu9o 
INTOOl 00 
INT001 1 0 
INT00120 
INTuoiSO 
IHT00140 
IHT00150 
INT00160 
IHT00170 
INT00180 
INTOOl 90 
1NT0U200 
IHT0021 0 
INT00220 
INT00230 
INT00240 
INT00250 
I  NT 00260 
1NT00270 
INT00280 
INT00290 
INT00300 
INT0031 0 
INT00320 
INT00330 
INT00340 
INT00350 
INT00360 
1NT00370 
INT00380 
1NT00390 
INT00400 
INT0041 0 
INT00420 
INT00430 
IHT00440 
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SUBkuUTIHE  r(MH2Ci<  v,  T,  PTOT ^  PH20 ,  DATH20,  ASH2u  > 

C 

Q  I*  >)■  sn  Dt «  « Id  in  41 in  m  in  4c  Ik  %  D<  *  I*  IK  *  » l*  *  «  «  »  <•  >«  «  W  4I «  *  «  «  4  *  41 )« '« >«< «  «  « i«<  He  « 

ROUTINE  TO  CALCULATE  H20  VAPOR  ABSORPTION  FOR  0  TO  350  GHZ. 

INPUTS  ARE:  WAVENUMBERS /'CM  TEMPERATURES  KELVIN  > ,  TOTAL 

PRESSURES TORR  ),  H20  VAPOR  PRESSURES TORR  ) ,  LINE  DATA  ARRAY. 
OUTPUT  IS:  H20  VAPOR  ABSORPTION 


CALLED  BY  MMuIGS  MAKES  NO  CALLS 
i  nr^i  pq  • 

WCD  VAPOR  COLUMN  DENSI  TVS /CM/'CM/'KM  > 

CT  LINE  STRENGTH  TEMPERATURE  CORRECTION 

CA  LINE  WIDTH  SELF  BROADENING  AND  TEMP.  CORRECTION 

3A  CORRECTED  LINE  STRENGTH 

GA  CORRECTED  LINE  WIDTH 

ABS  SINGLE  LINE  ABSORPTIONS /’KM  > 

4i  4<  *  4c «  4i  4i  4i  4< «  4i  4i  4i «  4i  4i  4i  4i  4<  4c  4i  4<  4c  Ik  4i  *  *  4c  4i  4>  •  4<  4i «  K  4i  4i  4i  4i  4c  *  41 4i  41 4c  4i  4i  4c  4c  4c  4c  4i  4i  4<  4i  4t  4i  4c  4i  4i  4>  4>  4c 


DIMENSION  DATH20S37,4> 

ABH20=0 . 

WCD=7 . 33994E264.PH20/'760  . /J*<  PFRS  T  >  ) 
CT-4.860773E-34CST-296.  >77 
CA=S  S  296  . /T  )•**  .  62  >4.S  PTOT+S  4 . 4cPH20  >  >/760  . 

DO  500  L»1 ,37 

SA=DATH20S  L,  2  )4cUCD4.EXPS  DATH20SL,  4  )4cCT  > 
GA=DATH20SL,3>4cCA 
ABS=SA4cSUPKS  V,DATH20SL,  t  ),GA) 
ABH20»ABH20+ABS 
500  CONTINUE 
RETURN 
END 


MMHOOOt  0 
MMH00020 
MMH00030 
MMH00040 
HMH00050 
MMH00060 
MMH00070 
MMH00080 
MMH00090 
MMHOOl 00 
MMH001 1 0 
MMHOOl 20 
MMH00130 
MMH00140 
MMH00150 
MMH00160 
MMH00170 
MMH00180 
MMHOOISO 
MMH00200 
MNH0  02<  0 
MMH00220 
MMH00230 
MMH00240 
MMH00250 
MMH00260 
MMH00270 
MMH002a0 
MMH00290 
MMH00300 
MMH0031 0 
MMH00320 
HMH00330 
MMH 00340 
HMH00350 
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SUBROLITIME  MMIDX<XL,T,  ICE,  HSOAB,  H20f<2  ) 

REF:  RAY,  APPLIED  OPTICS,  VOL.  11.  P.  1836,<1972> 

COMPLEX  CINDX.XK 
XXL=XL/1 0. 

TT=T-273. lb 
T3=TT-25. 

IFC ICE.NE. 0)  GO  TO  150 
PARAMETERS  FOR  WATER 

i  EFIm=5. 27137+ . 0216474*TT-1 . 31 1 SdE-3*TTfTT 
ALFA=-lb.8129/’T+.  0609265 
XLS=3 . 3836E-4'»EXP<  2513.  SS/T  j 

SIGMA=1 .25664E9  _  „  _ 

£3*78 . 54*< 1 . -4 . 579E-3+T3+ 1 . i 9E-5+T3+T3-2 . 8E-S+T3+T3+T3 ) 

GO  TO  200 

PARAMETERS  FOR  ICE 
150  EFIA=3.16S 

ALFA=0.288+0 . 0052+TT+2 . 3E-4*TT*TT 
XL3-9 . 390286E-5>*EXP<  1  .  32E4/<  1  .  9869+T  )  > 

SIGMA=1 .26*EXP<-1 . 25E4/^<  1  ,9869*T>) 

ES=2  03 . 1 68+2 . 5+TT+O . 1 5+TT+TT 
J  U=*(  ES-EFIN  )»<  XCS/XML  )<*+<  1  .  -ALFA  > 

T=  1  .  +2  .  *<  XLS/XXL  )*'*<  1  .  -ALFA  >*SIN<:  ALFA^I  .  57079633  )+ 

1  < XLS/XXL )**< 2-2+ALFA > 

EP=EFIN+<  <  ES-EFIN  >+U'»SIN<ALFA+1  .  57079633  >  iJ/Y 
EPP=^LUC0S<ALFA*1  .  57079633  )>7Y+S1&MA*XXL/’1  .88496E1  1 
RE=SQRT<  <  EP+SQRT<  EP+EP+EPP'*EPP  )  '>/2 ,  > 

AI  =  -6PP/'2./'RE 

IF< ICe.NE.O)  GO  TO  400 

IF<XXL.LE. .034)  GO  TO  307 
IF<XXL .GT. . 1 >  GO  TO  31 1 

i  R2=00P<XXL, 1 .83899,1639. ,52340.4,10399.2,588.24,345005., 

+  259913. ,161 .29,43319.7,27661 .2) 

R2=R2+R2*T3*  1  .  E-3>»EXP<  <  2 . 5E-5*XXL  i**  .  25  ) 

RE=RE*<  XXL- . 034  )/ . 066+R2*<  . 1 -XXL  V . 066 
GO  TO  311 

=■  RE=OOP<XXL,  1 .83899,  1639.  ,52340.4, 1  0399 . 2, 588 . 24 , 345005 . , 

+  259913. , 161 .29,43319.7,27661 .2> 

RE-RE+RE  +  T3*  1  .  E-3+EXP<  <  2 . 5E-5*XXL  )■*■*  .  25  > 

I  CONTINUE 

IF<XXL.GT.  .3)  CO  TO  500 

AI=AI+AB<XXL, .25,300. , .47,3. )+AB<XXL, , 39, 1 7 . , . 45,  1 . 3 > 

+  +A8<XXL, .41 ,62. , ,35, 1 .7) 

GO  TO  500 

j  CONTINUE 

IF<XXL.GT. 0. 08)  GO  TO  500 

105  RC=DOP<XXL, 1 .225,1652,9, 1 . 1 a082E6 , 46E-1 1,909,09,416441  .  ,  1  18852. , 
+  223.2,47031.8,126834.) 

RE=RE*<  XXL-0 , 02  )/0 . 06+R2*<  0 , 08-XXL )/0 , 06 

AI=AI+AB<XXL, .242,62., .23,1 . 6  )+AB< XXL, .581 , 44 , 8, 0 . 055, 1 . > 

)  CINDX=CMPLX<RE,AI ) 

XK*<  CINDX-*CINDX-1  )/'<  CINDX*ClNDX+2  ) 

H20AB=AIMAG<-XK) 

H20K2-XK*C0N JG<  XK ) 

RETURN 

END 


NMI0001 0 
nnioooao 

Mni00030 
MMI00040 
MMI00050 
MMI00060 
MMI00070 
MMI00080 
HHI00090 
MMIOOl 00 
HMIOOl 1 0 
HMI00120 
MMI0013C 
MMI00140 
HMIOOISO 
HMI00160 
MM100i70 
HMI00180 
MM  I u  0 1 9  0 
MMI 00200 
HMI002i 0 
HMI00220 
MMI00230 
MMI 00240 
MMI 00250 
MMI 00260 
MMI 00270 
MMI00280 
MMI 00290 
MMI00300 
MMI0031 0 
MMI00320 
MMI00330 
MMI0C340 
MMI 00350 
MMI 00360 
MMI00370 
MMI00380 
MMI 00390 
MMI00400 
MMI004t  0 
MMI00420 
MMI00430 
MMI 00440 
MMI004S0 
MMI 00460 
MMI00470 
MMI00480 
MMI00490 
MMIOOSOO 
MMI0051 0 
MMI00520 
MMI00530 
MMI00540 
MMI00550 
MMI00560 
MMI00570 
MMI00580 
MMI 00590 
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SUBkOUT I NE  MMOXy<  V , T , PTOT , PH2u , DATh02 . hBS02  > 

ROUTINE  TO  CALCULATE  ABSORPTION  DUE  TO  OXYGEN.  METHOD  IS  THAT  OF 

LIEBE,  GIMMESTAD,*.  HOPPONEH.  IEEE  TRANS.  ANT,  PROP.  V,25.  P327. 

INPUTS  ARE:  FREQUENCY< GHZ > ,  TEMPERATURE< kELVIN >,  TOTAL 

PRESSURE< TORR  ),  H20  VAPOR  PRESSURE< TORR > .  02  LINE  DATA 
ARRAY 

OUTPUTS  ARE:  02  ABSORPTION  < 1 /KM ) 

CmLLED  from  MMuIGS  CALLS  NO  OTHER  ROUTINES. 
local  VARIABLES; 

PHI  TEMPERATURE  CORRECTION  FOR  LINE  STRENGTHS 

S  CORRECTED  LINE  3TRENGTH<H2  TORR> 

GAMMA  CORRECTED  LINE  UlIDTH  <  1 /CH2  .  > 

klF  line  INTERFERENCE  FACTOR 

VMI  DATA02^ L, 1 J-V 

VPL  DATA02< L, I )+V 

PROFIL  MODIFIED  VAHVLECK-WEl SSKOPF  LINE  SHAPE 

- DIWFWSTJN  PATg077  42',g^ - 

A6SO2»0. 

T2*3CiO.,^T 

DO  500  L>1<42 

K-lFiy<  DATA02<L>6>) 

PHI-T2*T2*T2'*EXP<  -6  .e95E-3'«K>*<l<^1  >'»(T2-1  .  >> 

S-0 . 2  0Y5*PTOT*DATAO2<  Li2 )*PHI 

GAMMA-DATA02<L,  3>-*<  .929i»PT0T*T2-»».9+l  .  3fT2*PH20  >>*1  ,E-3 
XIF»DATACi2<  L  ,  4  )*T2*p0ATA02<  L  .  5  >*PTOT*1  E-3 
v'MlaDATA02<L,  1  )-V 
VPL*VMl+2i-V 

PROFIL-^  V/DATA02<L,  1  )  >•*<  <  GAMMA-VMI*XIF  '/'<  VMI^VMI+GAMMA^GAMMA  )♦ 
*  <  GAMMA-VPL^XIF  V<  VPL'*VPL+GAMMA’*CAMMA  )  > 

'  AeS02»ABS02+6*PR0FIL'*V*4  .  t92E-5 

CONTINUE 
RE  T URN 
END 


L 

50' 


MMOOOOi 0 
MM000020 
MM000030 
MM000040 
MM000050 
MM000060 
MM000070 
MM000080 
MM000090 
MM0001 00 
MM0001 1 0 
MM000120 
MMOOOi 30 
MMOOOI 40 
MMOOOI 50 
MMOOOI 60 
MMOOOI 70 
MM000180 
MM000190 
MMOOOZOO 
MM00021 0 
MM000220 
MMu00230 
MM000240 
MM000250 
MMO 00260 
HH000270 
HMD 00280 
HN00029D 
MM000300 
MM0003t  0 
MM000320 
MM000330 
MM000340 
MM000350 
MMO 00360 
MMO 00370 
HM000380 
MMO0Ci390 
MMO 004 00 
HHD004i 0 
MM000420 
MM000430 
MMO 00440 
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c 

c- 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c- 


c 

c 

c 


SUBROUTINE  MHRRN< RA I NRT , T , FREO, RTYPE, GRAIN, BSRA IN  > 

REF:  OLSEN,  ET . AL . ,  IEEE  ANT.  PROP.,  VOL. 26,  P,318<1978) 

ROUTINE  TO  COMPUTE  Thi  ATTENUATION  DU£~To”rAIn7"fOR 
FREQUENCIES  BETWEEN  10  «.  1  000  GHZ;  BACKSCATTER  ALSO. 

INPUTS  ARE;  FREGUEHCY< GHZ i,  TEMPERATURE< KELVIN >,  RAIN  RATEtMM/HR; 
OUTPUT  IS  ATTENUATION  (l/KM),  BACKSCATTER  < MM**2/MM*>i'3  > 

CALLED  FROM  MMUMOD  CALLS  NO  SUBROUTINES. 

LOCAL  VARIABLES: 

ALFA, BETA 

BSAT,BSBT 


A  AND  B  PARAMETERS  FUNCTION  OF  FREQ, 
TEMPERATURE,  AND  RAIN  TYPE 
POLYNOMIAL  COEF . 3  FOR  LINEAR  FIT 
TO  8ACKSCATTER=  ALF'ORAINRT*'*BET 


DIMENSION  ALFA<9,3,3),  BETA<9,3,3),  F<9>,  TK<  3  >,  A(  9, 3  > ,  B<  9, 3  >, 
+  BSAT<6,2),  BSBT<6,2> 


DATA  ALFA/I 


42E-2,3.34E-2, 

14E-2,2.82E-2, 

52E-3,2.20E-2, 

59E-2,3.94E-2, 

36E-2,3.68E-2, 


197. . 404. 1 . 1 1 . 1 .76.2 .36.2. 72.2.89, 

180. . 387.1 .18.1 .89.2.46.2.78.2.98, 

167. . 368. 1.24.2.05.2.58.2.84.2.89, 

275. . 379.1 .35.1 .80.2.07.2.22.2.00, 

268. . 579. 1.42.1 .88.2. 10. 2. 24. 2. 00, 


1 

7. 

1  . 

!• 

1  .  01E-2,3.57E-2i  .269',  .572;  1  . 46;  1  . 96;  2 . 1  3;  2 . 24 ;  2  i  01  ] 

1 .51E-2,4.20E-2, .376, .619, .871,1 .05, 1 .02, .972, .857, 

1 .69E-2,4.66E-2, .372, .629, .909,1 .04, .997, .976, .856, 

1 .90E-2,5.89E-2,  .  360,  .  61  0,  .  936, 1 .02,  .992,  ,997,  .856/', 
■r  BETA/. 932,  .954,  1  .  016,  1  .  027,  .943,  ,846,  .766,  .704,  .613, 

D  .968, 1 . 003, 1 . 053, 1 . 053, .941 , .829, .749, .692, .612, 

D  1.024,1.106,1.107,1.  082,  .936,  .807,  .  725,  . 679 .  . 61  , 

M  1 . 094, 1 . 088, 1 . 002, .904, .753, .686, .645, .618, .611, 

M  1 . 150, 1 . 1 18, 1 . 007, .905, .742, .677, . 64 1 , . 61 4 , . 61 0 , 

M  1 .260, 1 . 160, .999, .900, .732, .667, .635, .612, .610, 

T  1 . 087, 1 . 027, .784, .714, .657, .61 0, .608, .612, .614, 

T  1 . 076, 1 . 01 0, ,783, .709, .650, .610, .613, .611, ,615, 

T  1 . 079, .966, .782, .708, .642, .615, .615, .607, .615/ 

DATA  TK/263. 16,273. 16,293. 16/, 

+  F/1 0. , 15. ,35. ,50. ,95. , 1 40 . , 225 . , 31 0 . , 1000./ 

DATA  8SAT/-, 882488 lE+01 ,- . 1 029998E- 01 , ♦ . 245 1 205E- 04 , 

+  -.2462900E-07,+.6507628E-l 0,-. 1856080E-12, 

+  -,2127020E+02,+,6906017E+00,-, 1924260E-01 , 

+  + . 3035233E- 03, - , 2545323E- 05,4. 8673581 E- 08/, 

4  BS8T/4.7901887E400,-. 1 9001 896-02,4.6341 35 OE-05, 

4  4.3186429E-08,-.5933950E-1 0,4,9056715E-13, 

4  4 . 1361993E401 .4.3628100E-01 ,-.2461284E-02, 

4  4.4805257E-04,-,3988064E-06,4. 1193458E-08/ 

TR=T 

GRAIN=0. 

BSRAIN^O, 

IF<FREO.LT. to, )  GO  TO  200 

FR-FREQ 

ITYPE=IFIX<RTYPE40. 1 ) 

DO  10  1-1,3 
DO  10  J-1,9 

A<  J,  I  >-ALFA<  J,  I ,  I  TYPE  ) 

B<  J, I  )*BETA<  J, I, ITYPE) 
to  CONTINUE 

CALL  I NTRP<  A , B , TK , F , TR , FR , AA . BB , J  > 

GRAIN-<  AA*RAINRT**B8 )/4 , 343 

CALCULATIONS  FOR  RAIN  BACKSCATTER. 

AA-0. 

BB-0. 

IA-2 

IB-2 


MMROOOi 0 

MMR00020 

MMR00030 

MHR00040 

MMR00050 

MMR00060 

HHR00C70 

MMR00080 

MHR00090 

HMROOl 00 

MMR001 1 0 

MMR00i20 

MNR00t30 

MMR00140 

MMR00150 

MMR00160 

MMRuOl 70 

HMR00180 

MMR00190 

MMR00200 

HMR0021 0 

MMR00220 

MMR00230 

MMR 00240 

HHR00250 

MMR 00260 

MMR00270 

MMR00280 

MMR00290 

MMR00300 

MMR00310 

MMR00320 

MMR00330 

MMR00340 

MMR 00350 

MMR00360 

MMR00370 

MMR00380 

MMR 00390 

MMR00400 

MMR0041  0 

MMR00420 

MNR00430 

MMR00440 

MMR00450 

MMR00460 

MMR00470 

MMR00480 

HMR00490 

MHR00500 

HHR00510 

MMR00520 

NMR00530 

NMR 00540 

MMR 00550 

MMR 00560 

MMR00570 

MMR 00580 

MMR 00590 

NMROOeOO 

MMR0061 0 

MMR 00620 

MMR00630 

MMR 00640 

MMR 00650 

MMR 00660 

MMR00670 

KHR00680 

MMR00690 

MMR00700 
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1  00 
2  00 


IF<FREQ.GT.87,  >  1h=1 
IF<FREQ.GT.82.  )  18=1 
DCi  100  K=1  ,6 

8A=AA+BSATCK, I A  )♦< FREQ**< K- 1  >) 
BB=BB-^BSBT<K,  lB>«<FREQ>«i>»<K-1  )> 
CONTINUE 

8SRAIN=AA*RAINRT*>*BB 

RETURN 

END 


MMR0071 0 
MMR 00720 
MMR 00750 
MriR00740 
MMR00750 
MMR00760 
HMR00770 
MMR 00780 
MMR00790 
MMR00800 
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oor:»  o  .  *  ■  ■  I'  I  •  '•rinririoooooooooo 


SUBkOUT  I NE  MM3N0<  •St’tRT  ,  Tk  ,  FQ  ,  SHEx ,  SHBS  > 


FURPO&t;  TO  COMPUTE  SNOW  EXTINCTION  ANO  BACKSCATTER  X-SECTIOH. 


INPUTS:  SNOWFALL.  RATE<  MM/HR  > TEMPERATUREi  ktL  V I N  > ,  FREu'iJENCVC  CH2  > 
OUTPUT;  SNOW  EXTINCTION  ClkKrt;.  BACKSCATTERt:  M**2XM**3  >  . 
called  FROM  NMMW, 

LOCAL  VAF-*!  ARLES; 

Fk,TS  local  FRtuUENC  V  .  TtMFERATiJRE 

I  TYPE  INTEGER  SHOW  TYPE 

XLMDh  WAyELE.NGTHc  MM  > 

FFu,l  FREQUcHCV  Fill  INC  FACTORS 

TEMPERATURE  FITTING  FACTORS 

intermediate  a  values 

S'^JCi.l  INTERMEDIATE  B  VALUES 

TERMS  IN  EXT<  SNOW  >=AA*SNOWRATE**Be 
-iaPSi  T  term  in  esc ATC  show  t»AA*SNOWRATE*+1  .8 


.  i  '*  IAN  H  ^  9 , 3  >  j  6  <  3  j  3  •>  j  t-  <  S  >  j  TC  3  > ,  BSAT  <6.,2),BSBTCS,2>j  SF  C  T<  3  > 
.  A.  '  3 OE-S,  2 . 75E-3 .  !  .25E-2,2 .50E-2,8 , OOE-2, 1  .65E-1 , 

1  60E- 1  . S  ,  91 E- 1 , 1  . SSE+0, 

2  07E-2,4 . 34E-2. 1  .6  0E-1 ,2.  OOE-1 ,3 . 1  OE-1  ..  4  ,  OOE-1  , 

5  8  1  E-- 1 , 6 . 5  OE-1  ,1  .  1  1  E+0, 

6  22E-2,  A  ,  67E-2 . 2 , 35E-1  .3 . 41E-1 ,6,  t  OE-1  ..  8 ,52E-1  , 
7.83E-1  ,7,37E-1  .5.76E-1/ 

.  p.M  3,  1  46,  1  .6,  1  .54,  1  .26,  1  .  1  /  .89,  .79,  .6. 

I  '  3,  t  .2,  . 95,  .80,  .75,  .67,  ,65,  .64,  .60, 

>  ,  3, 1  .  2,  .  95,  ,  80  .  .75,  .67,  ,65,  .64,  .60/ 

DAT.-  F/  !  0  ,  1  5  ,  ,  35  .  ,50  .  ,  95  .  ,  140  .  ,225.  ,312.  ,  1  000./ 
data  T.-271  ,  ,273.  ,  275  .  / ,  SFCT/ 1  ,  ,3.  ,4./ 

DATh  BSATX- . 832483 1E+ 01 , - . 1 029998E-01 , + . 245r205E-04, 

♦  -  ,  24629  0  0E-07,  +  .65  07623E-1 0,-.  1856080E-12, 

+  -  .  21 27  02  0E+02,  +  . 69 06 0 1 7E+ 0 0 , - . 1 92426 OE- 01  , 

+  + . 3035233E-03,-, 2545323E-05,+,8673581E-08/, 

♦  eSPT/* , 7901 887E+00, - , 1 9 0 0 1 89E- 02 . + . 6341350E-05, 

+  + . 31 86429E-08, - . 593395 OE- 1 0 ,+, 90567 1 5E- 1 3 , 

♦  + , 1 361 993E+01 , + , 36281 OOE-01 , - . 246 1 234E- 02 , 

+  +.4S05257E-04,-.3988064E-06,+. 1 t93458E-08/ 

T  S  =  T  k 
FS-FO 
ICE-=1 
SHEX=0, 

■3NBS=0  . 

IF'- FQ  ,  LT  .  1  0  ,  )  GO  TO  200 
X:  MDA=299.79/FQ 

CALL  INTRP<A,B,T,F,TS,FS,AA,BB,  J ) 

SHEy,  =  AA'»SNRTT«T-BB 

CALCULATIONS  FOR  SNOW  BACKSCATTER. 

AA  =  0  . 

Be=c , 

IA  =  2 
I B  —  2 

IF<  FQ  .  GT  .  87  .  >  IA“^^1 
IF(FQ,GT.82, )  IB*1 
DO  100  i<=  1 , 6 

Art=AA+BSAT<K,  lA  )*<  FQ*>*<  K-1  )) 

Be*=BB+BSBT<K,  IB  )>*■<  FQ-*t<<  K- 1  )> 

100  CONTINUE 

AA=EXP<  Am  ) 

BB  =  1  .2>fBB 
F  1  =■;  FQ-  I  0  .  )/85  . 

FCT=  ,367  +  F1-<-.633 


MMSOOOt  0 
I1MSOOC2G 
MHSuOUju 
MMS 00040 
MMSOuOjO 
MMSOOOt.  0 
MMS00070 
MMSOOOSO 
MMS  0  0  0-9  0 
MM-T  001  0  0 
MMSOOi 1 0 
MMS  0  0 1 2  0 
MMSOOI 30 
MMSOOI 40 
M  M  S  0  0  1  D  'j 
MMS  0  0 1 6  0 
MMSOOI 70 
MMS  0  5 1 8  0 
MMSOOI 90 
MM SC  02 0  0 
MM-S0  021  0 
MMS 00220 
MMS 002^0 
MM SO  02 4  0 
MMS 00250 
MMS 00260 
MMS 00270 
MMS 00280 
MMS  0  029  Cl 
MMS 0 0300 
MMS 0031 0 
MMS 00320 
MMS 00330 
MMS 00340 

MMS  0  035  0 
MMS 00360 
MMS 00370 
MMS 00330 
MMS 00390 
MMSn04no 
MMS 004 1 0 
MMS 00420 
MMS 004 30 
MMS00440 
MMS 00450 
MMS00460 
MiMSOOA 0 
MMS00480 
MMS 00490 
MMS  0  0;.  00 
MMS  0  05 1 0 
MMS 00520 
MMS 00530 
MMS 00540 
MMS 00550 
MMS 00560 
MMS0  0^i7  0 
MMS 0 0580 
MMS00590 
MMS 006 00 
MMS 0061 0 
MMS 00620 
MMS 00630 
MMS00640 
MMS00650 
MMS 00660 
MMS00670 
MMS 00680 
MMS 00690 
MMS 007 00 
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IF<Fu.GT.95. >  FCT«1 . 
AAaFCT*AA 

1 1 0  IF<TK.GE.i75.  )  J=4 
SNBS»SFCT<  J-1 
C 

200  RETURN 
C 

ENO 


MHS0071 0 
MMSOI0720 
MHS00730 
MMS 00740 
MMS00750 
MMS00760 
HMS00770 
MMS 00780 
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C 


r.i  o  n  n  r*  nnnnrjCinn  n  r*  o 


SUBROUTINE  MMWFOcED, T, FREO, GFOG, BSFOG > 

DC «  « >*  4<  iC  « >«<  *  >•< « >K  « If  *  >•<  41  >)c  « IK  « sX  »  O  « IK  If  IK  W  *  *  >*  *  <•>  ■to*  >l»*  W  «  «  X- '«  «  «  *  If 

ChLCULhTES  hBSORPTION  OUE  to  UATER  FOGS/’CLOUDS, 

AND  BACKSCATTER  CROSS  SECTION  IN  Mif4i2/M*>*3 . 

INPUTS  ARE:  FOG  OENSlTYi  GM/M**!  ) .  TEMPERTURE<' KELVIN  >, 
FREQUENCY<GH2>. 

OUTPUTS  ARE:  FOG  ABSORPTIONf /"KH  BACK3CATTER  X-SECT I  ON<  Md.*2  M*d.3  >  , 

MHFOG  IS  CALLED  FROM  MMWMOD  CALLS  MMIDX  SUBROUTINE, 

LOCAL  VARIABLES: 

XLhDA  WAVELENGTH*:  MM) 

if  *  4,.  :f  DC  If  D<  If  D<  D<  D<  f  D<  Di  4<  f  Di  DC  D<  Dc  D<  D<  If  D<  4<  If  Dc  Di  Di  DC  If  » If  If  If  DC  Dc  Di  If  DC  Di  If  Di  If  If  D<  If  Dc  DC  If  DC  Dc  DC  4i  DC  Dc  If 

ICE=0 

IF<T.LT,243.  >  ICE=1 
C  COMPUTE  FOG  EXTINCTION 

XLnDA=10./<FRECi/^29.98) 

CALL  MM  I DX<  XLMDA , T , I CE . H20Ae , H20K2  > 

GFOG=1  8 . 8498f  H20ABifFD/^XLMDA 

eS'FOG=t  .  f  62E-CiS*H20K2*F0**<  .  PS/'C  XLMC)AifDi4  > 

RtTURN 

C 

END 


MMF0001 0 
MMF00020 
MMFOC1O3O 
MMFi;iu040 
MMFuOOSo 
MMF00060 
MMF00070 
MMF 00080 
MMF00090 
MMF001 00 
MMF001 1 0 
MMF00120 
MMF00(30 
MMF00140 
MMF  00)50 
MMFOOIbO 
MMF00170 
MMF00180 
MMF001 90 
MMF 002 00 
MMF  002)0 
MMF 00220 
MMF00230 
MMF  0  0240 
MMF 002^0 
MMF 00260 
MMF  0  0270 
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OOOriOOOOOOOOOOOOOOOOOOOOOOOOOOi 


SUBROUT  I NE  HHUGS<  T , P , rtH , FRO , GhS  > 

c 

SUBROUTINE  COMPUTES  Gi!)SEOUS  ABSORPTION  FROM  0  TO  1  000  GHZ  FOR 
H20  VAPOR  AND  02. 


MnGOOO i 0 
MMG00020 
MMG00030 
MMG00040 
MMG 00050 
MMG  0  0  06  0 
MMG00070 

INPUTS  INCLUDE!  TEMPEATURE'!  KELVIN ).  PRESSURE<  TORR  ABSOLUTE  HUMIDITYMMGOOOSO 


IN  GM/M**3,  FREQUENCY<GIGAHERT2). 

OUTPUTS  ARE:  GAS  ABSORPTION  <1,^KM> 

MMWGS  IS  CALLED  FROM  NMMW,  CALLS  < 1 >MMOXy< OXYGEN  ABSORPTION >. 
<2>  MMH20<H20  VAPOR  ABSORPTION). 

LOCAL  VARIABLES: 

DATAu2<L,J>!  OXYGEN  LINE  DATA,  L-LINE  NUMBER,  J-TYPE: 

J=t  :  LINE  FREQUENCY<GH2) 

2  !  LINE  STRENGTH  AT  300K 

3  !  LINE  WIDTH  AT  300k  <  GH2.-^TORk  > 

4  :  INTERFERENCE  PARAMETER  AT  300K 

5  !  INTERFERENCE  TEMPERATURE  CORRECTION 

6  !  LINE  QUANTUM  PARAMETER 

:  H20  LINE  DATA,  L»LINE  NUMBER, 

1  !  UIAVENUMBER<  1/CM) 

2  !  STRENGTH 

3  !  WIDTH<  1/CM,nORR> 

4  !  GROUND  STATE  ENERGY 
H20  VAPOR  ABSORPTION  <1/KM) 

02  ABSORPTION  <1.'‘KM) 

H20  VAPOR  PRESSURE<TORR> 

UAVENUMB£R< 1 /CM ) 


DATH20<L, J> 


GH20 

G02 

PH20 

UVNMe 


J=TYPE: 


4e «  4e )#i  )<c  ite ifi )|i « )|i 4i  4ii|( 4i 4i }(( i|( 4t  ^ 4c lit  *|( )|t  %  1ft  >•( «  % 41 

DIMENSION  DATA02<42,6),  DATH20<37,4> 

DIMENSION  D102<42,3),D202<42,3>,D1H20<37,2),D2H20<37,2) 
EQUIVALENCE  <DATA02< 1 , 1  ),D102< 1 , 1 >>,<DATA02< 1 ,4),D202< 1 , 1)> 
EQUIVALENCE  < DATH20< 1 , 1  ),D1H20<  t , 1 >>,<DATH20( 1 ,3>,D2H20< 1,1)) 


MMG00090 
MMG001 00 
MMGOOi 1 0 
MMG00120 
MMG00130 
MMGOOI 40 
MMGOOI oO 
MMGOOI 60 
MMGO0)70 
MMGOOI so 
MMGOOI 90 
MMG 002 00 
MMG0021 0 
MMG 00220 
MMG0U230 
MMG00240 
MMG00250 
MMG00260 
MMG 00270 
MMG00280 
MMG00290 
MMG00300 
MMG0031 0 
MMG 00320 
MMG00330 
MMG 00340 
MMG 00350 
MMG00360 
MMG00370 


COMMON  /lOUHIT/IOIN, lOOUT , IPHFUN, LOUNIT , NDIRTU , NCHMT, KSTOR , NPLOTUMMG 0 038 0 


DATA  D102/ 

1  49.451,49.961,50.473,50.987,51 .503,52.021,52.542,53.066, 

2  53.595,54.129,54.671 ,55.221,55.783,56.264,56.363,56.968, 

3  57.612,58,323,58.446,59. 164,59.590,60.306,60.434,61 .150, 

4  61 .800,62.411 ,62,486,62.998,63.568,64. 127,64,678,65,224, 

5  65.764,66.302,66.836,67.369,67.900,68.430,68.960,69.488, 

6  70. 016, 1 18,75, 

1  7.E-5,2.2E-4,6.E-4, 1 . 56E-3 , 3 . 86E-3, 8 . 99E-3, 1 .971E-2, . 04072, 

2  , 07919,  .1448,  .2489,  .4012,  .6056,  .3487, .8539, 1  ,1204,1  .3595, 

3  1.515,  .9251 , 1  .5263, 1.341,1 .3487, 1 .5626, 1 .5899, 1 .4588, 1 .2272, 

4  ,9634, .954, .6898, .4656, .2942, .1744, .0971, ,0508, .025, ,01 16, 

5  5. 08E-3,2. 1E-3,8.2E-4,3.E-4, 1  ,E-4,  ,5973, 

1  1  .26  0, 1  .31 0,  1 .330, 1  .360,  1  .38  0, 1 .41 0,  1 .440, 1  ,46  0, 1  .490, 

2  1.510,1 .540, 1.57 0,1, 601, 2. 212,1 ,635, 1 .672, 1.714,1 .762, 

3  1 .964, 1.819,1 .859,1 .890,1 .789,1 ,736, 1 .694,1 ,658, 1 .990, 

4  1  .627, 1 .598, 1  .568, 1  . 540, 1 . 51 0, 1 .490, 1 . 460, 1  .  440, 1  . 41 0 , 

5  1,380,1 ,360, I ,330,  1 ,31 0,  1 ,280,2, 140/ 

DATA  D202/ 

1  0.000, 0.0 00,  0.000,1. 040,  0.802, 0.897, 0.825,  0.780, 0.764, 

2  0.666,0.651 , 0,550, 0.481 ,0.931,0.371,0.254,0.1 00,-. 087, 

3  0 . 729 ,-.318,0.433,-. 543 ,0.179,-. 028 , - . 1 83 , - . 324 , - . 6 1 5 , 

4  -.41 9, -.537, -.591 ,-,693, -.703, -.796, -.8 08, -.849, -.9 16, 

5  - .822,-1 . 05, 0, 000, 0. 000, 0 . 000, - . 054, 

1  1  .00,1  .00,  1  .00,  1  .38,2.04,  1 .69,1 .91,1  .88,  1  .90,2.01,1  .95, 

2  2. 11, 2. 13, 0.89, 2. 36, 2. 66, 4. 20, -5. 8, 0.79. 0.11, 0.50, 0.69, 

3  -.99,7.60,3.04,2.34,0.85,2,24,2.02,2.04,1 .89,1 .95,1 .85, 

4  1.83,1.86,1,66,1,99,1 ,36,1 . 00, 1 , 00, 1 . 00, 0 . 89, 

1  41 . ,39. ,37. ,35. ,33. ,31 . ,29, ,27. ,25. ,23. ,21 ., 19. , 17. , 1 ., 15. , 13, 

2  11. ,9, ,3. ,7., 5. ,5. ,7., 9. ,11, ,13. ,3. ,15. ,17. ,19. ,21. ,23. ,25., 

3  27. ,29. ,31 . ,33. ,35. ,37. ,39. ,41 .,  1  ./ 


MMG00390 
MMG00400 
MMG 0041 0 
MMG00420 
MMG00430 
MMG00440 
MMG00450 
MMG00460 
MMG00470 
MMG00480 
MMG00490 
MMG00500 
MMG0051 0 
MMG00520 
MMG00530 
MMG00540 
MMG00550 
MMG 00560 
MMG00570 
MMG 00580 
MMG00590 
MMG00600 
MMG0061 0 
MMGC0620 
MMG00630 
MMG00640 
MMG00650 
MMC00660 
MMG 00670 
MMG 00680 
MMG00690 
MMG00700 
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oo  on  oo  ooi 


DATA  D1H20^ 

0  0.742. 06 . If  5, 06.790, 10.715, 10.846, 12.682, 14.778,  14.844, 
15.707, 15.834,16.294,18.270, 18.577,20.704,21 .960,24.860. 
25 . 085,30 .560,32 ,366,32 .954,36 .604,37. 137,37,91 0,38.638, 
38.791,39.1 12,40.282,40.520,42.639,43.243,43.631 ,44.100, 
46.750,47.053,48,059,49.765,49,820, 

.436E-24, .775E-22, . 186E-24, .250E-23, ,906E-22. .327E-21 , 

,  145E-22,  ,863E-21 ,  .270E-22. . 1 08E-21 , .219E-22,  .985E-22, 
.526E-19, .565E-21 , .531E-22, .664E-22, ,347E-19, . 143E-20, 

.  160E-20,  .252E-19,  . 164E-18,  .502E-19,  .333E-21 ,  .242E-20, 

. I79E-18, . 197E~21 , . 558E-19, . 155E-21 , ,707E-21 , .687E-21 , 
.51  IE-22,  .568E-20,  .302E-21 .  . 142E-18, ,930E-21 ,  .399E-22, 
.478E-227 
DATA  D2H20,-' 


081 
.111 
. 094, . 073 
. 091 , . 078 
446 .512, 

1 045. 069, 
23.794, 
3S3.843, 
173.366, 
1 079. 088, 
1693.6507 


.  094,  .  095,  . 063,  . 087,  . 091 , . 050, . 083, . 061 , 
1  07,  . 072,  .  1  1  1  ,  ,  1  03,  . 1  02,  . 084,  . 083,  .1  01, 
.  094,  . 063,  . 093,  . 098,  . 066,  . 074,  .  060, 
.  096,  . 097, 

136.164,  134,800, 1284. 921 ,  315,780, 

285.419,  742.079,  488.136.  586.482, 
488.110,1618.550,  69.920,  “  “ 

37.137,  136.761,  0.000, 

888.641,  275.498,1731.890, 


508.814,  398,392,  399.459, 


70.091, 
172.880, 
888.607, 
601 ,553, 


.  071  , , 075, 
.  097,  . 099, 
.  081  ,  . 084, 

2)2. 156, 
23.750, 
285.219, 
610.345, 
842.361 , 
100.391 , 


COMPUTE  WATER  VAPOR  PRESSURE,  FREQUEHCV  IN  WAVENUMBERS 
PH20=AH*T*3 . 462977E-3 
IFiiAH.LT.O.  )  PH20=-PSAT<T)#AH7100. 

WVNMB=FRQ729.98 

COMPUTE  H20  ABSORPTION 

CALL  MNH20<  WVNNB , T , P , PH20 , DATH20 , CH20  > 

COMPUTE  02  ABSORPTION 

IFCFRQ.LT. 140.  )  CALL  MM0XY< FRQ , T , P , PH20 , DATA02 , G02 > 

SUM  ABSORPTION 
GAS=GH20+G02 
C 

C  ^  ^  ^  ^  ^  ^  ^  94*  3(1  ^  ^  %  ifr  %  %  4i  9(1  %  %  ;4i  ift 

RETURN 

END 


MMG0071 0 
MMG 00720 
MMG00730 
MMG00740 
MMG00750 
MMG00760 
MMG00770 
MMG00730 
MMG00790 
MMG00800 
MMG0081 0 
MMG00820 
MMG00830 
MMG 00840 
MMG00850 
MMG00860 
MMG00870 
MMG00880 
MMG00890 
MMG00900 
MMG0091 0 
MMG00920 
MMG00930 
MMG 00940 
MMG00950 
MMG00960 
nHG00970 
MMG 00980 
MMG 00990 
MMG01 000 
MMG01 u1 0 
MMG 01 020 
MMG01 030 
MMG 01 040 
MMG01 050 
MMGOt  060 
MMG01 070 
MMG01 080 
MMG01090 
MMG01 1 00 
MMG01 1 1 0 
MMG0n20 
MMG01 130 
MMG 01 140 
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oo 


FUNCTION  PFR< T ; 

COMPUTE  H20  PARTITION  FUNCTION  CORRECTIONS 

DIMENSION  VIB<3) 

DhTh  VIB^3693. 9,  1614,5,3801  .6/' 

CiJ=296./T 
QJ=QJ*SQRT<QJ) 

Ti=-1 .43879/'296. 

T2=-1 .438797T 
T1S=1  . 

TiS=1  . 

DO  10  J=1,3 
V=VIB<  J> 

T1 1-1 .-EXP<T1*V> 

T22-1 . -EXP<  T2^V  > 

T1S=T1S*T1 1 
10  T2S=T2S*T22 

PFR=Q  Jx<T2S/T  1  S 
RETURN 
C 

END 


PFROOui 0 
PFR00020 
PFR0u030 
PFR00040 
PFR00050 
PFR00060 
PFR00070 
PFR00080 
PFR00U90 
PFR001 00 
PFR001 1 0 
PFR00120 
PFR001 30 
PFR00140 
PFROOtSO 
PFR001 60 
PFR001 70 
PFR00180 
PFR0019U 
PFR00200 
PFR0021 0 
PFR00220 
PFR00230 
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FUNCTION  PSAKT) 


00 
0  0 


Ei.i.i=C  1  *<  TR- 1  .  >+C2‘*‘NL0G1  0<  TR  >+C3*<  1  0  .  C4»<  1  .  -TR 1  >  J-l  .  >+ 

+  C  1  0  .  *>•<  Cb'i'<  TR-1  .  >  i-1  .  )+C7 
GO  TO  200 
TR=TO,'-T 
TRI=T/’TO 

Eul=Di  TR-1  .  >+D2fHL0G1  0<  TR  >+D3‘t‘<  1  .  -TRl  >+E>4 
PSAT=<  1  0  .  **Elj  )*CON V 
RE lURN 
END 


PSAT001 0 
PSAT0020 
PSAT0030 
PSAT0040 
PSAT0050 
PSAT0060 
PSAT0070 
PSAT  OOSO 
PSAT  0050 
PSAT01 00 
PSATOi i 0 
P8AT0120 
PSATOi 30 
PSAT0140 
P5AT  0150 
PSATOI 60 
PSAT  0170 
PSATOI SO 
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r«r> 


SUPk  ilOf  0 
SUPK0020 
SUPKOOSO 
SUPK0040 
SUPK005& 
SUPK0060 
3UPK0070 
SUPKOOSO 
SUPi<0090 

supkoi 00 


SUPKOi 1 0 


3UPK0»20 


SUPKOI 30 


SUPKOMO 

SUPKOISO 


SUPK0160 
SUPKOI 70 


ooooooooowoorjooooocjo  or.'Oor‘OOoor.oo.r.ir.*o  r-ir..r.r>ooo«~  onor*”.  r"’''r>r*r<nooo 
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SUBROUTINE  CLTRhN' CTRANS , UhVE , IRON, IERR> 

DIMENSION  TflUCZO) 

DIMENSION  X 1  <  2  0  ) ,  Y  1  (  2  0  > ,  2 1<  2  0  > ,  X  0  <;  2  u  > ,  Y  0  2  U  j ,  2  0  <  2  0  > 

COMMON  XCLYMAT/TEMP, PRESS,RH, AH. DP. VIS,CLDAMT,CLDHYT,FOGPRB. 
UNDVEL.UHDDIR  .  IPASCT 

COMMON  XLEVELXISLTUP, ISLTDN, IH0RI2. IVERT, TESALL , TESARG , TESVT 
COMMON  /PATHLXX0,Y0,2  0.X1  ,Y1  ..  21  .  XS ,  YS ,  2S .  XT .  YT  .  ZT  .  ATTLC  2  0  ) 
COMMON  XBASTOPXZBAS, 2T0P. ICL, IWV, ILCTYP< 1 0  ), ICCTVP< 1 0  > 

COMMON  XCYLXXC.YC. RADIUS 


CLTOuO  t  0 
CLT00CI20 
CUT  00030 


CLT00040 
CLT00050 
CLT00060 
CUT  0  0 07  0 


COMMON  /lOUHITXIOIN. lOOUT . I PHFUK , LOUHI T , HDI RTU . NCL IMT , KSTCR , HPLCTUCLT C 0C80 


COMMON  XBASTHX2LBASE< 1 0),2LTHIC< 1 0>,ZCBASE< 1 0).2CTHIC^ 1 0> 

+  .RADICL1:  1  0  ) 

COMMON  XINTCLXXCLOUD< 1 0  ), YCLOUD< 1 0>.NLINT<  1 0  ) . NC I NT< 1 0  ) 

♦♦  DATA  IS  READ  FROM  INPUT  RECORDS  AND  THEN  TRANSFERRED  TO  CLTRAN 
**  BY  SUBROUTINE  CLREAD.  INPUT  TO  CLTRAN  IS  CARD  uRDER-INDtPENDENT. 

WITH  A  FOUR-LETTER  IDENTIFIER  IN  COLUMNS  1-4  OF  EACH  INPUT  RECORD 
**  THE  ONLY  EXCEPTION  TO  THIS  ORDER- I NDEPENDEHCE  IS  THE  GO  SENTINEL 
CAPO,  which  MUST  BE  THk  LAST  RECORD  READ.  ALL  CARDS  ARt  RtAD  IN 
★  -f  UNDER  THE  FORMAT  <  A4 .  1  X .  5<  E 1  0 . 5 .  1  X  >  >  .  THE  IDENTIFICATION  AND 
OF  EACH  INPUT  RECORD  ARE  AS  FOLLOWS  : 

CARD  IDENTIFIER  ;  SEEk 
variables  read  i  XS.YS.ZS 

XS. YS.ZS  =  POSITION  COORDINATES  OF  SEEKER  COR  RECEIVER>  < KM > 

CARD  IDiNTIFliR  !  TARG 
VARIABLES  READ  1  XT.YT.ZT 

XT. YT.ZT  *  POSITION  COORDINATES  OF  TARGET  < KM ) 

THE  FOLLOWING  FOUR  CARDS  REPRESENT  THE  STRATIFORM  CLOUDS  TREATED 
BY  CLTRAN,  THEY  ARE  TREATED  AS  INFINITE  LAYERS  IN  A  PLANE-PARALLEL 
**  ATMOSPHERE. 


CARD  IDENTIFIER  !  CLST  < STRATUS  CLOUD  TYPE) 

VARIABLES  READ  !  2L8ASE . 2L TH I C 

2LBASE  =  H'"IGHT  OF  CLOUD  BASE  <KM) 

ZLTHIC  =  V  RTICAL  THICKNESS  OF  CLOUD  LAYER  <.KM> 

CARD  IDENTIFIER  i 
VARIABLES  READ  : 

CLAS  <ALTOSTRATUS  CLOUD  TYPE) 

ZLBASE. ZLTHIC 

CARD  IDENTIFIER  1 
VARIABLES  READ  i 

CLNS  <NIMBOSTRATUS  CLOUD  TYPE) 

ZLBASE, ZLTHIC 

CARD  IDENTIFIER  ! 
VARIABLES  READ  : 

CLSC  <STRATOCUMULUS  CLOUD  TYPE) 

ZLBASE, ZLTHIC 

**  THE  NEXT  TWO  CARDS 

REPRESENT  THE  CUMULUS  CLOUD  TYPES  ADDRESSED 

**  BY  CLTRAN,  CLOUDS  OF  THIS  KIND  ARE  MODELLED  AS  CYLINDERS  WHICH 
1.*  HAVE  VERTICAL  SYMMETRY  AXES.  THESE  TYPES  ARE  REPRESENTED  BY 
**  THE  FOLLOWING  RECORDS  ! 


CARD  IDENTIFIER 
VARIABLES  READ 


:  CLCH  < CUMULUS  HUMILIS  CLOUD  TYPE) 
ZCBASE.ZCTHIC.RADICL.XCLOUD,  YCLOUD 


ZCBASE  =  HEIGHT  OF  CLOUD  CYLINDER'S  LOWER  BASE  < KM > 

ZCTHIC  =  VERTICAL  THICKNESS  OF  CLOUD  CYLINDER  < KM > 

RADICL  *  RADIUS  OF  CLOUD  CYLINDER  < KM > 

XCLOUD  ■  X-COORDINATE  OF  VERTICAL  AXIS  OF  CLOUD  CYLINDER  < KM ) 
YCLOUD  =  Y-COORDINATE  OF  VERTICAL  AXIS  OF  CLOUD  CYLINDER  < KM ) 


CARD  IDENTIFIER 
VARIABLES  READ  i 


:  CLCC  < CUMULUS  CONCESTUS  CLOUD  TYPE) 
ZCBASE  .ZCTHIC. ,  RADICL ,  XCLOUD .  YCLOUD 


**  THE  FOLLOWING  CARD  MUST  BE  THE  LAST  RECORD  READ  : 


CLTOOOSO 
CLTOOl 00 
CLT001 1 0 
CLTOOl 20 
CLT  00150 
CLTOOl 40 
CLT00150 
CLT  00160 
CLT  00170 
MEAHINGCLT00130 
CLT00190 
CLT  00200 
CLT  0  02 i 0 
CLT 00220 
CLT00230 
CLT00240 
CLT0O250 
CLT00260 
CLT00270 
CLT00280 
CLT00290 
CLT00300 
CLT0031 0 
CLT  0  0320 
CL  TO 0330 
CLT  00.340 
CLT  00350 
CLT  0  0360 
CLT00370 
CL TO 0380 
CLTU0390 
CL  TO  04 0  0 
CLT0041 0 
CLT00420 
CLT  00430 
CLT00440 
CLT00450 
CLT00460 
CLTC0470 
CLT00480 
CLT00490 
CLT00500 
CLT0051 0 
CL TO  052  0 
CLT00530 
CLT00540 
CLT00550 
CLT00560 
CLT00570 
CLT00580 
CLT00590 
CLT  00600 
CLT0061 0 
CLT00620 
CLT00630 
CLT00640 
CLT00650 
CLT00660 
CLT00670 
CLT 00680 
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ChRD  identifier 

VARIABLES  READ  ; 


IF< IRUN.GT. 1 >  GO  TO  5 
NLAYER=0 
NCCLDS=0 
5  CONTINUE 
IWV=0 

2BMIN=999. 

FOCPRB*0 . 

IF<UIAVE.GT.  0.20,AND.WAVE.LT.2, 00>  IWV*1 
IF<WAVE.GT.3, 00 . AND . WAVE . LT . 5 . 00 >  |WV«2 
IF<WAVE,GT.  8. O.AND.WAVE.LT. 12. 0>  1WV=3 
IF< IWV.NE. 0>  GO  TO  50 
IERR-1 

WR1TE< lOOUT, 22  ) 

22  FORMAT<  1H0,20X,94H*>t>>»CLTRAN  ERROR***  INPUT  WAVELENGTH  DOES  NOT 
+  WITHIN  ALLOWABLE  LIMITS,  EXECUTION  TERMINATED  / > 

GO  TO  900  _ 

50  CALL  CLREAO<NLAYERiNCCLDS, IERR> 

IF< lERR.EQ, 1 )  GO  TO  900 

ISLTUP-0 

ISLTDN-O 

IHORIZ^O 

IVERT=0 

C****  DETERMINE  SENSE  OF  L-O-S  SLOPE  FROM  SEEKER'S  POINT  OF  VIEW 
C 

TESVERa<  X3-XT )**2*<  Y8-YT )**2 
IF<TESVER.EQ. 0. 0>IVERT»1 
IFflVERT.EQ.I )GO  TO  300 
IF< ZS-2T >200,210,220 
200  ISLTUP=1 
GO  TO  300 
210  IH0kI2«1 
GO  TO  300 
220  ISLTON=1 
300  CONTINUE 

IF< IH0RI2.EQ. 1 >GO  TO  310 

C****  COMPUTE  L-O-S  SLOPES  IN  X-Z  AND  Y-2  VERTICAL  PLANES 


C****  COMPUTE  L-O-S  SLOPES  IN  X-Z  AND  Y-2  VERTICAL  PLANES 
C 

XIX=<  X3-XT  >/< 2S-ZT  > 

XIY=»<  YS-YT  >✓'<  ZS-ZT  ) 

310  CONTINUE 
C 

C****  STRATIFORM  CLOUD  BLOCK 
C 

IF<NLAYER.EQ. 0)GO  TO  500 

C****  UTILIZE  DEFAULT  BASE  OR  THICKNESS  VALUES  IF  NECESSARY 

^  CALL  DEFSET< 1 ,NLAYER> 

DO  400  N-1,NLAYER 

NLINT<N>*0 

Z0<N>-2LBASE<N) 

2UN>»Z0<N>+2LTHIC<N> 

ZBA3-20<N> 

ZT0P=Z1<N> 

ICL=ILCTYP<N> 

IF<2BMIN.LT.ZLBASE<N>>  GO  TO  320 
ZBMIN-ZLBASE<N> 

FOGPRB-FLOAT< ICL) 

320  CONTINUE 

C****  DETERMINE  X,Y,Z  INTERSECTIONS  OF  L-O-S  AND  CLOUD  LAYER  <  IF_,^ 
C,****  THERE  ARE  ANY>i  <  XK  N  >,  Y1<  H  >,  ZU  N  )  >■  UPPER  INTERSECTION  POINT, 
C****  <X0<N>,Y0<N>,20<N>>-  LOWER  INTERSECTION  POINT 


CLT  00690 
-CLT  00700 
CLT 0071 0 
CLT00720 
-CLT00730 
CLT 00740 
CLT  0  075  0 
CLT 00760 
CLT  00770 
CLT00780 


CLT  00790 
CLT 008 00 
CLT00S1 0 
CLT  0  082  0 
CLT  0  063  0 
CLT00840 
LIECLT00850 
CLT00860 
CLT00870 
CLT00880 
CLT00890 
CLT00900 
CLT 0091 0 
CLT 00920 
CLT 00930 
CLT 00940 
CLT0095U 
CLT00960 
CLT 00970 
CLT00980 
CLT00990 
CLT01 000 
CLT01 01 0 
CLT01 020 
CLT01 030 
CLT 01 040 
CLT01 050 
CLT 01 060 
CLT01 070 
CLT 01 080 
CLT01 090 
CLT01 1 00 
CL  I  0 1 1 1 0 
CLTOl 120 
CLT01 130 
CLTOl 140 
CLTOl 150 
CLTOl 160 
CLT01 170 
CLTOl 180 
CLTOl 190 
CLTOl 200 
CLT  0121 0 
CLT01220 
CLT01230 
CLT01240 
CLTOl 250 
CLT 01 260 
CLTOl 270 
CLT01280 


CLT01290 
CLT01300 
CLT0131  0 
CLT01320 


L 

c 


CALL  LAyRXY<XIX.Xiy,N> 
ir<TESALL.LE.O.O)GO  TO  350 
NLINT<N>=N 

IF  THERE  ARE  ANY  INTERSECTIONS,  DETERMINE  OPTICAL  DEPTH 


CALL  CLEXTH<TAUN,N> 

TAU<N)»TAUN 

ATTL<  N  >=SORT<  <  XI <  N  >-X0<  N  >  :>**2*<  Y I  <  N  >-Y0<  N  >  >**2+<  2 1  <  N  >-2 0<  N  >  .»**2  > 
GO  TO  400 

IF  HO  INTERSECTIONS  WERE  FOUND,  THE  OPTICAL  DEPTH 
IS  NOW  SET  TO  ZERO 
C 

35  0  TAiJ<N;)=0. 0 
ATTL<  N  >=*0 . 0 
400  CONTINUE 
C 

c 
c 

50  0 

c****  utilize  default  base,  thickness,  or  radius  if  necessary 


END  stratiform  CLOUD  BLOCK 
CUMULIFORM  CLOUD  BLOCK 
IF< NCCLDS . EQ , 0 >GO  TO  SOS 


CALL  DEFSET<2,NCCLDS > 

DO  800  N=1 .NCCLDS 
NNsHLAYER-fN 
NCINT<N)=0 
Z0<NN)«=2CeASE<N> 

21 <  NH  )=20<  NN  >+2CTH ICC  N ) 

IC;L=ICCTYP<N>  .  ^ 

IFCZBMIN.LT.ZCBASECN))  GO  TO  520 
ZBMIN=2CBASE<N) 

FOGPRe*FLOAT< ICL  > 

520  CONTINUE 

RADIUSsRADICLCN) 

XC-XCLOUD<N) 

vc=ycloud<:n> 

ZBAS=20<  NN> 

ZTOP=Zt<NN> 

TESARGaO. 0 
TESVT=0. 0 

C**>**  DETERMINE  X,Y,Z  INTERSECTIONS  OF  L-O-S  AND  CUMULUS  CLOUD  CYLINDER 
C****  <IF  THERE  ARE  ANY)!  < X1< N  ) , Y1 < N ) , Z1 < N ) )=  UPPER  INTERSECTION  POINT 
<XO<N>,YO<N>,ZO<N))«  LOWER  INTERSECTION  POINT 

CALL  CYLXY<XIX,XIY,NN> 

IF>;TESALL,LE.O.O.OR.TESARG,LT.O.O.OR.TESVT.LT.O.O)GO  TO  650 
NCINT<N>aN 
C 

C#***  IF  THERE  ARE  ANY  INTERSECTIONS.  DETERMINE  OPTICAL  DEPTH 

C 

CALL  CLEXTNCTAUN.NN) 

TAU<  NN  >-TAUN 

ATTL<  NN  >=SQRT<  <  XI  (  NN  >-X0<  NN  )  '•♦2+<  YU  NN  )-Y0<  NN  )  ^**2+ 

■K21<NN>-Z0<  NN)>>**2> 

GO  TO  800 

IF  MO  INTERSECTIONS  WERE  FOUND,  THE  OPTICAL  DEPTH 
c***»  IS  HOW  SET  TO  ZERO 

650  TAU<NH>-0.0 
ATTL<NN)»0. 0 
aoo  CONTINUE 


CLT  01330 
CLTOI 340 
CLT01 350 
CLT01360 
CLTOI 370 
CLT0i3S0 
CLT013S0 
CLTOI 400 
CLT0141 0 
CLTOI 420 
CLT01430 
CLTOI 440 
CLTOI 450 
CLT0M60 
CLT  01470 
CLT0f4S0 
CLTOI 490 
CLTOI 500 
CLiOt  5i 0 
CL  10152  0 
CLT  01530 
CLI01540 
CL  I  OIsdO 
CLTOI 560 
CLT01570 
CLT01580 
CLT01590 
ClTOISOu 
CLT0161 0 
CLT01620 
CLT01630 
CLTOI 640 
CLTOI 650 
CLT01660 


C 

Cf***  END  CUMULIFORM  CLOUD  BLOCK 


CLTOI 670 
CLTOI 680 
CLT 01 690 
CLT01700 
CLTOI 71 0 
CLT01720 
CLT  01 730 
CLTOI 740 
CLT01750 
,CLT01760 
CLT01770 
CLT01780 
CLT01790 
CLTOI 800 
CLTOI 81 0 
CLT01820 
CLT01830 
CLT01840 
CLT01850 
CLT01860 
CLT01370 
CLT01880 
CLT01890 
CLT01900 
CLT0191 0 
CLT 01 920 
CLT01930 
CLT01940 
CLT01950 
CLT01960 
CLT01970 
CLT01980 
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SUBROUTINE  Lj^VRXYc;  XIX,  XI Y,  IN  ) 

LOGICAL  INSEEK, INTARG 

DIMENSION  X1<20),Y1<20),ZK20>.XO(20),YO<20).ZO<20) 

COMMON  /LEVEUXISLTUP, ISLTDN, IHORIZ, IVERT, TESALL , TESARG , TESVT 
COMMON  /PATHLXXO, YO, Z0,X1 , Y t , Z 1 , XS , YS , ZS , XT , YT , ZT , ATTL< 2 0 > 
C****  CHECK  LOS  TO  SEE  IF  IT  INTERSECTS  THE  CLOUD  LAYER 
UPlsISLTUPf'JZS-ZK  IN;) 

UP2=ISLTUP'i'<  Z0<  IN>-2T) 

&NI»ISLTDN*<2T-Zt< IN>> 

DH2=ISLTDN*<20< IN>-ZS j 

H0R12=IH0RI2*<ZS-21( 2S-20< , u> 

UPVER1  =  IVERT*<  2T-Z3 )♦<  ZS-Zl < IN  >> 

UPVER2»I  VERTti<  2T-2S  J*<Z0<  IN  )-2T  > 

TESALL=UP1*UP2+0N1*DN2+H0R12  +  UPVER1=t«UPVER2 
iF<  TESALL  .  LT  .  0 . 0  ;)RETURN 
IF< IH0RI2.E0. 1 JRETURN 


COMPUTE  X,Y  INTERSECTIONS  OF  CLOUD  PLANES  AND  LOJ 
ALSO,  CHECK  FOR  THE  CASE  WHERE  EITHER  THE  SEEKER 
OR  TARGET  IS  INSIDE  OF  THE  CLOUD 


INSEEK=Z3.LE 
INTAkG=ZT . LE 
IF-;  ISLTUP.EO 
IF< ISLTON.EQ 
IFC ISLTUP.EO, 
IF'',  ISLTDN  .  EO  , 


21<:iN>.AND.2S.GE.Z0<IN> 
2t< IN  > . AND . 2T .GE . 20< IN  > 
1 .AND. IHTARG>21< IN>*2T 
1  . AND . INTARG  )Z0< IN )-2T 
1  .AND.  1NSEEK)20<  1N>=*2S 
1  .AND.  INSEEK  >21  <  IN:)=2S 


Xt< IN)=XS+XIX*<2I< IN>^2S  > 
YU  1N>-YS+XIY*<21<  1H>-2S> 
X0<  IN  )=XS+XIX>*<  Z0<  IN  )-2S  ) 
Y0<  IN>=YS+XIYf<ZO<  IN  >-2S  ) 
RETURN 
END 


LAY  0  001  0 
LAY00020 
LAY00030 
LAY00040 
LAV00050 
LAY00060 
LAYOOOZO 
LAY  0  0 08  0 
LAY 00 090 
LAYOOl 00 
LAY 001 1 0 
LAYOOl 20 
LAYOOl 30 
LAYOOl 40 
LAYOOl 50 
LAY00160 
LAYOOl 70 
LAYOOISO 
LAY00190 
LAY00200 
LAYOOZi 0 
LA VO  0220 
LAV002 jO 
LAV00240 
LAY  0  0250 
I.AY00260 
LAV00270 


LAY00280 
LAY 00290 
LAY00300 
LAY 0031 0 
LAY00320 
LAY00330 
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SUBROUTINE  CYLXVt XIX , XI Y , IN > 

DIMENSION  X1<20>,Y1<20),ZI<20),XO<20),YO<20>.2  0<20> 

COMMON  /"CYL/XC^YC, RADIUS 

COMMON  /LEVEL/'ISLTUP. ISLTDN, IHORIZ, IVERT. TESALL , TESARG, TESVT 
COMMON  XPATHLXXO, Y0,20,X1 , Y 1 , 21 , XS , YS , 2S, XT , YT , ZT , ATTL< 2 0 ) 

COMMON  /BASTOP/ZBAS.ZTOP, ICL, IWV>ILCTyP< 1 0>> ICCTYPC 1 0) 

C***^  FIRST  DETERMINE  INTERSECTION  PTS  OF  LOS  WITH  UPPER 
C****  AND  LOWER  BASE  PLANES  OF  CLOUD  CYLINDER 
TESaLL^O . 0 

CALL  LAYRXY<XIX,XIY, 1N> 

IF<  TESALL ■ LT . 0 . 0  )RETURN 
X0L»YR=S0< IN) 

Y0LAYR=Yu< IN ) 

20LAYR=ZO< IN> 

Xi  LAYk=X1  <  IN  '; 

YILAYR=Y1< IN; 

21  LAYR=Z i  <  IN  '; 

C**H»o  CALCULATE  NEXT  THE  INTERSECTION  PTS  OF  THE  LOS 

WITH  THE  SURFACE  OF  AN  INFINITE  VERTICAL  CYLINDER  WITH 

THE  SAME  RADIUS  <RADIUS>AND  LATERAL  POSITION  <XC.YC>  AS  THE  CLOUD 

IF<  IVERT.NE. 1  )GO  TO  40 

VERTE3=SQRT<  <  XT-XC  )**2*< YT-YC  >**2 ) 

TESVT=RADIUS-VERTES 

IF<  VERTES.lt.  RADIUS  :>GO  TO  400 

RETURN 

40  IF<<XT-XS ) .EQ . 0. 0;GO  TO  60 

alpha=<;  yt-ys  )/<  xt-xs  ) 

A2»ALPHA*t.2 
C2“l , 0+A2 

C  t  *>2 . 0*<  ALPHA>»<  YT-YC-ALPHAfXT  >-XC  > 

C 0sXC>*'*2+<  YT-YC-ALPHA*XT  )**2-RkbtUS**Z 

TESARG»C1’*"*'2-4 . 0'*'C2>*>C0 

IF<  TESARG . LT . 0 . 0 IRETURN 

XP-<  -C 1  +8QRT<  TESARG  >  >X<  2 . 0«*>C2  > 

XM*< -C  f -SORT<  TESARG ))/<2. 0*02 > 

YP=iYT+ALPHA-*<XP-XT) 

YM-YT+ALPHA*<XM-XT> 

IF< IHORIZ.EQ. 1 >GO  TO  300 
ZM=ZS+<  1  .  OXXIX  >■»<  XM-XS  ) 

2P-23*<  1  .  0XXIX)ti<XP-XS> 

C-*-***  CHECK  FOR  SKEW  MISS  OF  CLOUD 
T0PP-2P-2T0P 
TOPM»ZM-ZTOP 
BASP-ZBAS-ZP 
BASM-2BAS-ZM 
1F<<T0PP+T0PM>.LT.  0 
TESALL—1  .  0 
RETURN 
60  XP=*XT 

TESARG=»RADIU8**2-<  XP-XT 
I F<  TESARG , LT . 0 . 0 ;RETURN 
VP=YC+SORT< TESARG) 

XM=XT 

Y!1=YC+80RT<  TESARG) 

IF'J  IHORIZ.EQ.  1  )GO  TO  300 
2M=2S+< 1 . OXXIY)f<YM-YS) 

2P=2S+< 1 . OXXIY)»(YP-YS) 

Cf***  CHECK  FOR  SKEW  MISS  OF  CLOUD 
TOPP=ZP-2TOP 
T0PM*ZM-2T0P 
BASP-ZBAS-ZP 
BASM-2BAS-ZM 
IF<<TOPP*TOPM),LT. 0 
TESALL— 1  .  0 
RETURN 

50  IF<2P.LT.ZM>C0  TO  100 
XOCYL-XM 
YOCYL-VM 
ZOCYL-ZM 
XICYL-XP 

245 


O.OR.<BASP'»BASM).LT.O.  0)GO  TO  50 


O.OR.<BASP>»BASM).LT.  0. 0)GO  TO  50 


UYLUUUl U 
CYL00020 
CYL00030 
CYL00040 
CYL00050 
CYLOOOe  0 
CYL00070 
CYL0008U 
CYLOOOSu 
CYL  00 1 0  0 
CYL0,01  1  0 
CYLOOICO 
CYLiSCii  3  0 
CYLOOMO 

Cvl  0  'J  1  Zj  0 

CYL  0  0 1 6  0 
CYL  C  Oi  1-  0 
CYL  (.10)8  I'l 
CYLOOiSu  , 
C  YL  0  02  0  0  k‘ 
CYL0021 0/ 
CYL 00220 
CrL002ju 
CYL 00240 
CYL  u  02=1  0 
CYL 00260 
CYL 00270 
CYL 00280 
CYL002SO 
CYL 003 00 
CYL0031 0 
CYL 00520 
CYL  00330 
CYL00340 
CYL00350 
CYL 00360 
CYL0037  0 
CYL00380 
CYL00390 
CYL00400 
CYL004t  0 
CYL00420 
CYL00430 
CYL 00440 
CYL0045O 
CYi.00460 
CYL00470 
CYL 00480 
CYL 00480 
CYLOOSOO 
CYL 0051 0 
CYL 00520 
CYL00530 
CYL 00540 
CYL00550 
CYL 00560 
CYL00570 
CYL00580 
CYL 00580 
CYL 006 00 
CYL0061 0 
CYL00620 
CYL00630 
CYL 00640 
CYLuOfcSO 
CYL00660 
CYL00670 
CYL 00680 
CYL00680 
CYL00700 


( 


Y1CYl.  =  yP 

CYL0071 0 

21 CYL=ZP 

CYL 00720 

GO  TO  200 

CYL00730 

1  Ou 

XOCYL=XP 

CYL 00740 

YOCYL=YP 

CYL 00750 

20CVL=2P 

CYL 00760 

X1CYL=i<:M 

CYL00770 

Y1CVL=YM 

CYL007S0 

21 CyL=ZM 

CYL00790 

200 

CONTINUE 

CYLOOSOO 

GO  TO  450 

CYL 0081 0 

3  0  0 

X0<  IN  ;)=XM 

CYL 00820 

Y0<  IN  )=YN 

CYL00830 

2 O';  IN  >=2T 

CYL 00840 

X  K I N  >=XP 

CYL 00850 

Yi<  in:)=yp 

CYL 00860 

2 1 <  IN  ;=2T 

CYL  0  08 1-0 

GO  TO  500 

CYL00880 

400 

XO';  IN  ;=;<T 

CYL 00890 

y 0^ IN  >=YT 

CVL00900 

XU  IN  >=XT 

CYL 0091 0 

YU  IN  )=YT 

CYL00920 

GO  lO  500 

CYL00930 

450 

IP<;Z0CVL.LT,20LAYR>GO  TO  460 

CYL 00940 

XO':  IN  OCYL 

CYL 00950 

Y0< IN  >=Y0CYL 

CYL 00960 

2 O';  IN  ;=^ OCYL 

CYLu0970 

GO  TO  470 

CYL 00980 

46  0 

XO';  IN  )=X0L^»YR 

CYL 00990 

YO'i  IN  )=Y0LAYR 

CYL01 000 

2u<  IN)=20LfiYR 

CYL01 01 0 

470 

IF<21CYL.GT.2fLAVR>G0  TO  480 

CYL 01 020 

X  U  IN  >'=X  1 CVL 

CYL01 030 

YU  IN)=Y1CYL 

CYL 01 040 

2U  INJ-sZICYL 

CYL01 050 

GO  TO  500 

CYL 01 060 

48  0 

XU  IN)=X1L8YR 

CYL01 070 

YU  IN)=Y1L8yR 

CYL 01 080 

21 ';  IN)=21LAYR 

CYL 01 090 

500 

RETURN 

CYL01 1 00 

ENO 

CYL01 1 1 0 
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SUBROUTINE  CLEXTH-;  TAUN,  IN  > 

DIMENSION  AA<42  ),BB<42>,CC<42 ),A<7>6,3> 

DIMENSION  Xt<2O),Y1<20),2K2O),XO<2O>,YO<2O>,ZO<20> 

EQUIVALENCE  < AAf 1  ) , A< 1 , 1 , 1  )  ) , < BB< 1  ) , A< 1 , 1 . 2 >  ) , ( CC< 1  5 , A<  t . 1 , 3  )  > 
COMMON  /PATHLXXO, Y0,Z0,X1 ,Y1 ^21 , XS , YS , 2S , XT , YT , ZT , ATTL(  2 0 > 
COMMON  XLEVEL/ISLTUP, ISLTDN. IH0RI2, IVERT, TESALL / TESARG, TESVT 
COMMON  /BASTOPXZBAS,ZTOP,  ICL,  lUIV 

DATA  AA/S , 3744E-2, 2. 9313E-4, -1 . t300E-6, 1 .6228E-9,-1 . 0421 E-1 2, 
+2.4192E-16, 0. 0OOOE-OO,8.4451E-2, 1 . 6549E-4 , -4 . 73 0 OE-7 , 

■•■4 , 4334E- 1  0.  -1  .  385 IE- 13.  -2 . 0644E-17.  1  ,2569E-2  0,  1  ,  024  0E-1  . 

+  4 , 8678E-5 . -2.21 95E-7 . 1 , 45  06E- 10,5. 9393E- 14,-8. 7250E- 1 7 , 

+2. 1383E-20,3.6775E-2, 1 . 6 1 60E-4, -6 . 4666E-7 , 9 . 5298E-1 0, 

+  -ib.4023E-13,  1  .6916E-16,-7.9924E-21 ,1  .841  OE-2 , 6 . 6870E-4 , 

+-2 . 8406E-6 , 5 . 4478E-9 , -5 . 4854E-1 2, 2 . 7932E- 15,-5. 8271 E- 19, 

+3 .3458E-2, 1 .3098E-4, -4 . 1528E-7,6. 1 166E-1 0 , -4 . 668 1 E- 1 3 , 

+1 .7383E-16,-2,5043E-20/ 

DATA  BBX7.5099E-2,3.2061E-4,-1 . 7060E-6 , 3 . 3538E-9 , -3 . 27 1 9E- 1 2 , 

+  1  .572  IE- 15, -3. 0123E-19, 1  . 1808E-1 , 2 . 2387E-4 , -8 . 7996E-7 , 

+1 . 1298E-9,-6.6823E-13, 1 .7514E-16,-1 .5665E-20, I .4155E-1 , 

+-5 . 0592E-5,-1 . 2280E-7, 1 ,2715E-1 0 , 2 . 747 OE- 1 4 , -6 , 694 OE- 1 7 , 

+1 .7734E-20,4.9533E-2,2.0904E-4,-1 . 1 626E-6 , 2 . 353 1 E-9 , 

+-2 .3463E-12, 1 . 1 472E- 1 5 , -2 . 2267E-1 9, 3 . 83 1 5E-3, 1 , 1837E-3, 

+  -5 . 1  096E-6 , 9 . 466  OE-9 , -8 . 6426E- 1 2, 3 . 6778E- 15,-5. 5775E- 1 9 , 

*4, 1534E-2,2. 0220E-4,-8, 1463E-7, 1 ,3590E-9,-1 . 1 142E-12, 

+  4 . 3867E- 16,-6. 6426E-2  0/ 

DATA  CCXl . 1269E-2,2.8659E-4,-6. 0210E-e,-1 . 5274E-9 , 2 . 7747E- 1 2 , 
+-1 .8946E-13,4,5539E-19, 1 .9856E-2, 1 . 2292E-4 , -8 . 4479E-8 , 

+  8 .6563E-12, 0 . 000 OE-0 , 0 . 000 OE- 0 , 0 . OOOOE-0,3 . 1907E-2, 

♦1 . 9632E-4,-1 .111 4E-7, -3 .3907E-1 0, 5 , 2528E- 1 3, -2 .7799E-16, 

+5, 0469E-20,6.8522E-3, 1 . 5362E-4 , 7 . 581 3E-8 , - 1 . 1430E-9, 

+1 .8885E-12,-1 .2477E-15,2.9522E-19,8.5792E-4,6.4122E-5, 

+7. 7271E-7,-2.9750E-9,4.4014E-12,-3, 0626E-15,8. 154  IE- 19, 
+3.7151E-3, 1 .4919E-4,-9.3486E-8,-1 .2183E-1 0, 1 .8733E-13, 
+-9.2167E-17, 1 .59398-20/ 

TALIH=0.  0 
2ZA=Z0< IN)-2BAS 
226=21 < IN)-2BAS 
VERDIS-Z2B-22A 

H0RDI3=SQftT<;<Xl<  IH)-X0<  IN  >  >t<*2+<  Y1<  IN  >-Y0<  IN>>**2> 
EL=S«RT<H0ft£)IS'»*2+VERDIS**2> 

IF<  EL . EO . 0 . 0  >RETURN 
IF< IHORIZ .EO . 1 >GO  TO  200 
XI=VEkOIS.'^EL 
ELA=ZZA*1 000. 0 
ELB=<XIt.EL+Z2A)*1  0  00. 0 
POLVA=0. 0 
POLYB=0. 0 
DO  100  N=1 , 7 
EN=FLOAT<N  > 

AN=A<N, ICL, IWV) 

TERMB=<  1  .  0/<XI't‘EN>)>»AN’t‘ELBf*N 
TERMA=<  1  ,  0/<  X I  ♦EN  >  >'*AN*ELA*»N 
PuLYh=POLYA+TERMA 
100  POLYB=POLYB+TERMB 
TaUN=POLYB-POLYA 
GO  TO  300 

200  Z2A=22A*1  000 . 0 
DO  250  N=1 , 7 

TERMK:  =  A<N,  ICL,  IWV)*HORDIS»1  000.  OfZZAffCN-l  > 

250  TAUN=TAUN+TERMK 
300  RETURN 
END 


CLEOOOi 0 
CLE00020 
CLE00030 
CLE00040 
CLEC0050 
CLE00060 
CLE00070 
CLE00080 
CLE00090 
CLEOOl 00 
CLE001 1 0 
CLE00120 
CLE00130 
CLE00t40 
CLE  0  015  0 
CLE00160 
CLEOOl 70 
CLEOOl 80 
CLE00190 
CLE00200 
CLE0021 0 
CLE00220 
CLE00230 
CLE0C240 
CLE00250 
CLE00260 
CLE 00270 
CLEOOZeO 
CLE00290 
CLE00300 
CLE0031 0 
CLE00320 
CLE00330 
CLE00340 
CLE00350 
CLE 00360 
CLE0O37O 
CLE 00380 
CLE 00390 
CLE 004 00 
CLE 0041 0 
CLE00420 
CLE0043D 
CLE 00440 
CLE00450 
CLE00460 
CLE 0  047  0 
CLE 00480 
CLE00490 
CLE 005 00 
CLE0051 0 
CLE 00520 
Cl  1 0  053  0 
CLE 00540 
CLE00550 
CLE 00560 
CLE00570 
CLE 00580 
CLE00590 
CLE00600 
CLE006  1  0 
CLE00620 
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SUBROUTINE  LISOUK  NN , CTRANS . TAUTOT . TAU, NLhYER , IRUN  > 

K  OUTPUT  CONTROL  ROUTINE 
DIMENSION  ALPH<  6  > , T<  20  > , TAU<  2  U ) 

DIMENSION  XK20),yi<20>,2K20),XO(:20),VO<20>,ZO<20> 

COMMON  /PATHL/  X 0 , Y 0 , Z 0 , X 1 , Y 1 , 2 1 , XS , YS, 2S , XT , YT , 2T , ATTL< 2 0 ) 
COMMON  XLEVEL/ISLTUP. ISLTON, IHORIZ, IVERT, TESALL , TESARG . TES VT 
COMMON  XBAST0PX2BAS,2T0P, I  CL, lUV, ILCTYP< 1 0>, 1CCTYP< 1 0> 

COMMON  /eASTH/ZL8ASE< 1 0  ), ZLTHIC<  t  0  ),ZCBASE< 1 0>,ZCTH1C<  tO) 

+  ,RADICL<  t  0  ) 

COMMON  XINTCL/XCLOiJD<  10),YCLOUD<  I0),NLINT<  I0),NCINT<  »0> 


LISOOOl 0 
LIS00020 
LIS00030 
LI  SO  0  04  0 
LI300050 
L1S00060 
L1S00070 
LISOOOSO 
HS00090 
LIS001 00 
LIS001 1 0 
L1S00120 


COMMON  XIOUHIT/’IOIH, lOOUT, IPHFUN , LOUNIT , NDIRTU , NCL 1 MT , KSTOR , NPLOTUL 1 S 00 1 30 


DATO  ALPHX2HST,2HAS, 2HNS,2HSC,2HCH,2HCCX 
1P<  lUV  ,EQ  .  1  >li)VL  =  0 . 55 
I  Ft  IUV.EC,2)WVL  =  3.8  0 
It-',  IwV.E0.3>UVL=10.60 
I  Ft IRuN,LT.2>  UftITE< lOOUT, (50)UVL 
IF'  IRUN.GT. 1  )  UR!TE<  lOOUT,  160 JWVL 
)  FORMAT< 1HO,40X, IZHWAVELEKGTH  *  ,F5.2,9H  MICRONS  /> 

3  FORMAT< 1H0,40X, 13HUAVELENGTH  “  ,F5.2,9H  MICRONS  /> 

IF< IHORIZ.EQ . 1  >URITE< IOOUT,200) 

IFC  I  VERT . EQ . 1  >URITE< I00UT,21 0  ) 

IF< ISLTUP.EQ. 1 >WRITE< IOOUT,220) 

IFt  ISLTDN.EQ.  1  JURITE<  IOOLIT,230) 

3  FORMATt 1H0,40X,28HLINe-OF-SlGHT  IS  HORIZONTAL  XX) 

3  FORMAT< 1HO,40X,26HLINE-OF-S1GHT  IS  VERTICAL  XX) 

3  FORMAT<  )H0,40X,28HHNE-OF-SIGHT  SLANTS  UPWARD  XX) 

3  FORMATC 1H0,40X, 30HLINE-OF-SIGHT  SLANTS  DOWNWARD  XX) 

PTHL.EH  =  SQRT<  <  XS-XT  )**2-*-<  YS-YT  )*'*2+<  ZS-ZT  >♦♦2  ) 

UPITE'.  IOOUT,30  0  )PTHLEN 

3  FOPM6T< 1H0,40X,29HTOTAL  L I NE-OF-S I GHT  LENGTH  »  ,F7,3,4H  KM  ) 
ATTLEN=0 , 0 

IF.  TAIJTOT  ,  EQ  .  0 . 0  >GO  TO  780 
DO  310  N=1 , NN 
3  ATTLEN=ATTLEN-tATTL<N  ) 

WRITEt  IOOLIT,  400  )ATTLEN 

)  FORMAT< 1H0,40X,50HTOTAL  L I NE-OF-S IGHT  LENGTH  INTERRUPTED  BY  CLOUD 
+=  ,F7.3,4H  KM  > 

WRITE<  IOOUT,5C(0)TAUTOT 

3  FORMAT< 1H0,40X,22HTOTAL  OPTICAL  DEPTH  =  , F7 . 2X  ) 

WRITE<  lOOUT , 60  0  )CTRftNS 

3  FORMAT< 1H0,40X,36HTRANSMITTANCE  ALONG  L INE-OF-S I GHT  x  ,£11.5, XX) 
WPITE<  I001JT,605) 

j  FORNAT< 1H0,40X,5CHSEEKER  COORDINATES  < KM  )  TARGET  COORDINATES  <K 
iJPITEt:  IOOUT,6  06) 


OPTICAL  DEPTH  =  , F7 . 2X ) 


L1S00)40 
L1S00150 
LIS00160 
LIS001 70 
L I S  0  0  1  S  0 
LIS00190 

ONS  X)  LIS00200 

ONS  X  >  L1S0021  0 

L ISO  0220 
LISn0230 
LIS00240 
L ISO  025  0 

L  XX)  LIS00260 

XX)  LIS00270 

D  XX)  LIS00280 

ARD  XX)  LI  SO  0290 

)  LIS00300 

L130031 0 

»  ,F7,3,4H  KM  )  LIS00320 

LIS00330 

LIS00340 

LIS00350 

LIS00360 

LI300370 

INTERRUPTED  BY  CLOUD  LIS00380 

LIS00390 

LIS00400 

2X)  LIS00410 

LIS00420 

F-SIGHT  X  , Ell. 5, XX)  LIS00430 

LIS00440 

TARGET  COORDINATES  <KMLIS00450 


,E1 1 .5, XX) 


t  1  )  LIS00460 

iJPITEt:  IOOUT,6  06)  LI300470 

FORMAT<1H  ,40X,23HXSEEKER  YSEEKER  ZSEEKER , 3X, 23HXTARGET  YTARGET  ZTLIS00480 

+ARGET)  LI300490 

WRITE< IOOUT,607)  LIS00500 

’  FORMAT<1H  ,40X,3<8H -  ),2X,3<8H - ))  LIS0051  0 

WPITE< IOOUT,608)XS, YS,ZS,XT, YT,ZT  LIS00520 

?  FORMAT.;  1H0,4OX,3<F6.3,2X),2X,3<F6.3,2X)>  L1S00530 

WPITE< I00UT,613)  LIS00540 

3  FORMAT<1H  , XX )  LIS00550 

WPITEt I00UT,615 )  LIS00560 

5  FORMAT< 1H0,40X,62HCLOUD  TYPE  L I NE-OF-SIGHT  INTERSECTION  COORDLIS00570 

■fl  NATES  <KM)  )  LIS00580 

IJR1TE<  IOOUT,620>  LIS00590 

}  FORMAT<1H  .40X,10HXID  NUMBER , 4X , 47HXUPPER  YUPPER  ZUPPER  XLOWERL IS00600 

+  YLOWER  ZLOWER)  LIS00610 

WR1TE< I00UT,625  )  LIS00620 

5  F0RMAT<1H  ,40X,10H - ,4X,3<8H -  ),1X,3<8H -  ))  L1S00630 

IF<NLAYER .EQ. 0>GO  TO  685  LIS00640 

DO  670  N=1,NLAYER  LIS00650 

IND»ILCTYP<N>  LIS00660 

IF<NLINT<N).Efl. 0>GO  TO  670  LIS00670 

WRITE<  IOOUT.6eo  :)ALPH<  IND  N,  XU  N  >,  YU N  >,  Z t  < H  >,  X0<  H  >,  Y0<  N  > ,  Z0<  N  )  LrS00680 

D  CONTINUE  LIS00690 

O  FORMAT< 1H0,42X,A2, 1HX, I2,6X,3<F7.3.1X>, 1X,3<F7.3, 1X>>  L 13007 00 
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bS5  NLO*NLHVEK+i  LISo07iCi 

IFCNLAYER.EQ.NNJGO  TO  699  LIS00720 

LL=u  LIS00730 

DO  690  N=NLO,NN  LIS00740 

LL*LL+1  LIS00750 

IMD=ICCTYP<LL)  LIS00760 

IF^NClHTiLD.EQ,  OiGO  TO  690  LIS00770 

IJRITE<  lOOUT,  68  0  >ALPH<  IMD  ,  N,  X 1  <  N  Y  1<  N  ),  2  K  N  >,  X0<  N  >,  Y  0<  N  ) ,  ZOi:  N  >  LI  SO  0730 

CONTINUE  LIS00790 

WRITE< I0CUT,613>  LISOObOO 

UR1TE( I00UT,691 )  LIS00810 

FORMAT< 1HO,40X,59HCLOUD  TYPE  CUMULUS  CENTER  POSITIONS  (FOR  CC  ORLIS00820 

CH  TYPES)  >  LIS00830 

WRITE< I00UT,692 >  LIS0u840 

FORMATdH  ,40X,10H/ID  NUMBER ,  6X ,  26HXCL0UD  (KM)  YCLOUD  (KM))  LIS00850 

WRITE< I00UT,693)  LIS00860 

FORMATdH  ,40Xd0H - ,6X,26H -  - )  LIS00870 

LL=0  LIS00880 

DO  695  N=NLO,NN  LISu0S90 

LL=LL+1  LIS00900 

InD= ICCTYP( LL )  LISOOyjO 

WRITE<  lOCLIT.  696:)ALPH<  IND  ) ,  N,  XCLOUD<  LL  ).  YCLOUDvLL  >  LI  SO  092  0 

FORMATC 1H0,42X,A2, 1 H/ , 1 2 d  OX , F7 . 3 , 8X, F7 , 3 )  L ISO 093  0 

CONTINUE  LI SO  094  0 

iJRITE<  lOOUT,  61  3  )  LIS00950 

DO  610  N=1 .NN  LIS00960 

T(N)=EXP<-TAU<N))  LIS00970 

IF(NCCLD8,GT. 0)  WRITE< lOOUT, 700  )  LIS009S0 

IF<NCCLDS.LT. I  )  URI TE< lOOUT . 7 05 )  LIS00990 

F0RMAT< IHl ,20X, 1 1HCLOUD  TYPE  , 2X , 1 5HHE IGHT  OF  BASE  .2X,  LISOIOOO 

fOHTHICKNESS  , 2X, 1 6HRADIUS  OF  CLOUD  . 2X, 1 4H0PTICAL  DEPTH  ,2X,  LIS01010 

14HTRANSMITTANCE  )  LIS01 020 

FORMAT<  lH0,20Xd  1HCLOUD  TYPE  .. 2X,  1 5HHEICHT  OF  BASE  ,2X.  LIS01030 

10HTHICKNESS  , 2X, 1 6HRA0IUS  OF  CLOUD  , 2X ,1 4H0PT IC AL  DEPTH  ,2X,  LISOl 040 

14HTRANSMITTANCE  )  LISOl 050 

WRITE< IOOUT,71 0)  LISOl 060 

FORMATdH  ,20XdOHXID  NUMBER,  9X,  4H<  KM  ),  9X,  4H(  KM  )  d  2X .  4H<  KM  ).  9X ,  L1S01070 
11HALONG  L-0-S,5X, 1 1HALONG  L-O-S)  LISOl 080 

WRITE< IOOUT,720)  LISOl 090 

FORMATdH  ,20X,10H - ,3X,t4H - ,3X,9H - ,  LISOIIOO 

3X,  15H - ,3X,  13H - ,3X,  13H - )  LISOl  1  1  0 

IF<NLAYER.EQ. 0)GO  TO  735  LIS01120 

BLANK=0.0  LISOl 130 

DO  730  N=1,NLAYER  LISOl 140 

IHD-ILCTYP<N)  LISOl 150 

730  WRITE< IOOUT,760)ALPH< IHD ), N, 2LBASE<N ), 2LTHIC< N ), BLANK, TALK  N ), T< N >  LISOl 160 
735  NLO=NLAYER+l  LISOl 170 

740  IF<NN,EQ.NLAYER)GO  TO  800  LISOl 180 

LL=0  LI301I90 

DO  750  N=NLO,NN  LIS0t200 

LL=LL+1  LIS01210 

IHD=»ICCTYP<LL)  LIS01220 

750  WRITE< IOOUT,760>ALPH< IND ), N, 2CBhSE< LL ), ZCTHIC< LL > , RADICL( LL ) ,  LIS01230 

+  TAU<N),T(N)  LrS01240 

76  0  FORMAT< 1H0,22X, A2, 1 H7 , 1 2 , 1  OX , F7 . 3, 7X , F7 . 3 , 8X , F7 . 3 , 1  OX , F7 . 2 , 7X ,  LISOl 250 

+E11,5)  LIS01260 

GO  TO  800  HS01270 

780  URITE< IOOUT,790)  LIS012S0 

790  FORMATdHO,20X,59HNO  CLOUD  OBSCURATION  :  L-O-S  DOES  NOT  INTERSECT  LIS01290 
+ANY  CLOUDS  //">  LISOl  300 

800  RETURN  LI301310 

END  L1S01320 


690 

691 

692 

693 


695 

696 
699 


61  0 
700 
705' 

H 

710 

720 


M 


SUBROUTINE  DEFSEK ISTEP, NMAX > 

C 

C***-*  THIS  ROUTINE  RESETS  THE  CLOUD  BASE  HEIGHT,  THICKNESS, 

AND  RADIUS  VALUES  TO  THE  NEAREST  REALISTIC  BOUNDARIES 
IF  THEY  DO  NOT  LIE  CLOSE  TO  THE  RANGES  SPECIFIED  IN 
R.  D.  H.  LOU'S  PAPER. 

COMMON  /’BAST0P/'ZeAS,2T0P,  ICL,  lUV,  ILCTVP<  1  0>,  ICCTYP<  1  0> 
COMMON  /'BASTH/ZLBASE<  1  0  ),2LTHIC<  1  0),2CBASE<  1  0>,ZCTHIC<  1  0> 


♦,RADICL< 1 0 ) 

IF< ISTEP.NE. 1 )G0 
DO  5  N=t,NMAX 
ITYPE=ILCTYP<N) 
IF< ITYPE.EQ.2>G0 

1  IF<2LBASE<N>.LT. 
IF<2LBASE<N).GT. 
IF< ITYPE.EG.3>G0 

2  IF<2LTH1C<N).LT, 
IF<2LTHIC<N>.GT. 
GO  TO  5 

3  IF<2LBASE<N>.LT. 
IF<2LBASE<N>.GT. 

4  IF<:ZLTHIC<N),LT. 
IF<ZLTHIC<N>.GT. 

5  CONTINUE 

10  IF< ISTEP.NE,2>G0 
DO  15  N=1 ,NMAX 
IF<ZCBASE<N).LT. 
IF<ZCBASE<N>.GT. 
IF<2CTHIC<N),LT. 
IF<ZCTHIC<N),GT. 
IF<RADICL<N).LT. 
IF<RADICL<N;.GT. 
15  CONTINUE 
20  RETURN 
END 


TO  1  0 


TO  3 

0.  1  >2LBASE<N>= 
1 .5:)2LBASE<N>= 
TO  4 

0,2>ZLTHIC<N>s 
1  .  0  j2LTHIC<;N>= 

2. 0>2LBASE<N>= 
5. 0>2LBASE<N)= 
1  .  0)ZLTHIC<N)  = 
4, 0>2LTHIC<N)= 

TO  20 

0.8>2CBASE<N)' 
1 .5)ZCBASE<N)" 
0.2)2CTHICCN>> 
5. 0)2CTHIC<;N)= 
0.05 >radicl<n: 
0,6)RADICL<N>= 


DEF0001 0 
DEF00020 
DEF00030 
DEF00040 
DEFOuOSO 
DEF00060 
DEF0007U 
DEF00080 
DEF00090 
DEF001 00 
DEF001 1 0 
DEF00120 
DEF00130 
DEF00140 
DEF00150 
DEF00160 
DEFOOiZO 
DEF00180 
DEFOOi 90 
DEF00200 
DEF0021 0 
DEF00220 
DEF00230 
DEF00240 
DEFU0250 
DEF00260 
DEF00220 
DEF00280 
DEF00290 
DEF00300 
DEF0031 0 
DEF00320 
DEF00330 
DEF00340 
DEF00350 
DEF00360 


SUBROUTINE  CLREhO<  NLhYER , NCCLDS, IERk  > 

DIMENSION  IALPHft< 18 >,DATELT<5> 

DIMENSION  X1<20).  Y1<20),21<20),X0<20>,Y0<20),Z0<20> 

COMMON  /PATHL2X0, YO, 2  0,X1 , Y 1  .  2 1 . XS , YS , 2S , XT , YT . 2T , ATTL< 2 0 > 
2GE0MET2PTS< 15), IGEOSW 

/BASTOP/ZBAS^ZTOP, ICL, lUV, ILCTYPC  1 0  >, ICCTYP<  1 0 ) 


COMMON 

COMMON 

COMMON 

COMMON 


CLftOOO 1 0 
CLR00020 
CLROOOSO 
CLR00040 
CLR00050 
CLR00060 


/lOUNIT/IOIN,  lOOUT,  IPHFUN,  LOUNl T ,  ND IRTU ,  NCL IMT ,  XSTOR  ,,  NPLOTUCLR 0  0 07 0 


60 


100 


50 


200 

300 


35  0 


400 


.  NE . 1  )GO  TO  60 


/BASTH/ZLBASEC 10),2LTHIC< 10>,2CeASE< )0),ZCTHIC<  1  0 > 
+,RADICL< 1 0 ) 

COMMON  2INTCL/XCL0UD< 1 0),YCLOUD< 10),NLINT< 1 0>,NCINT< 1 0) 

DATA  1ALPHA/2HCL,2HST,2HCL,2HAS,2HCL,2HN£,2HCL,2HSC;,2HCL,2HCH, 
+2HCL,2HCC, 2HSE,2HEK, 2HTA,2HRG,2HG0,2H  / 

ISFLAG«0 
ITFLAG=0 
IF':  IGEOSU . 

XS=PTS<4) 

YS=PTbc  5  ) 

2S=PTS<6) 

XT=PT3< 1  ) 

YT=PTS<2  ) 

2T=PTS<3> 

CONTINUE 
DC  900  N=1 , 23 

READ<  lOIN,  1  OOIALPH,  I  ALP ,  <  DATELT<  I  ),  1-1 ,5> 

F0RMAT<2A2, 1X,S<E10.5,1X)) 

INDEX=1 0 
Du  200  K=1 ,17,2 

IF<< lALPH.EQ, 1ALPHA<K)).AND.<IALP.EQ, lALPHA<K+t )>>  GO  TO  50 
GO  TO  200 
REALK=FLOAT<K) 

RQT=REALK22. 0 
k J=IFIX<ROT  >*i 
INDEX-KJ 
GO  TO  300 
CONTINUE 

IF< 1N0EX,LT,7)G0  TO  < 350 , 350 , 350, 350 , 400 , 400 >, INDEX 
INM6-INDEX-6 

GO  TO  <500,600,999,997), INM6 
NLAYER=HLAYER+1 
IF<NLAYER.GT. 10)  GO  TO  993 
ILCTYP<NLAYER)=INDEX 
ZLBASE<NLAYER ’=DATELT<  1  ) 

2LTHIC<  NLAYER  )=DATELT<  2 ) 

GO  TO  900 
NCCLDS-NCCLDS+  1 
IF<NCCLDS .GT . 1 0)  GO  TO  995 
ICCTYP<NCCLD3)=INDEX 
2CBASE<NCCLDS )-DATELT<  1  ) 

2CTHIC<  NCCLDS  )=DATELT<  2  > 

RADICL<  NCCLDS  )=DATELT<  3 ) 

XCLOUD<  NCCLDS )=DATELT<  4 ) 

YCLOUD<  NCCLDS  )=DATELT<  5 ) 

GO  TO  900 

500  IF< ISFLAG.EQ. 1 )  GO  TO  997 
XS=DATELT< 1  ) 
yS=DATELT<2 ) 

Z3=DATELT<  3  ) 

ISFLAG-1 
GO  TO  900 

600  IF< ITFLAG.GT. 1 )  GO  TO  997 
XT-DATELT< 1 > 

YT=DATELT<2) 

2T=DATELT<3) 

ITFLAG-1 

900  CONTINUE 
GO  TO  999 

993  IERR=1 
WRITE< I00UT,994) 

994  FORMAT<  1H0,20X,76H<i"»i'CLREAD  ERROR-*"** 

+NPUT  EXCEEDS  THE  LIMIT  OF  10  // ) 


NUMBER  OF  STRATIFORM  CLOUDS 


CLR00080 
CLR00090 
CLR001 00 
CLR001 1 0 
CLR00120 
CLR00130 
CLR00140 
CLROu 1 50 
CLftOOl 60 
CLR001 70 
CLR00180 
CLROOi 90 
CLR00200 
CLR0021 0 
CLR 00220 
CLR00230 
CLR00240 
CLR00250 
CLR00260 
CLR00270 
CLR00280 


CLR00300 
CLR 0031 0 
CLR00320 
CLR00330 
CLR00340 
CLR00350 
CLR00360 
CLR00370 
CLR 00360 
CLR 00390 
CLR 004 00 
CLR004i 0 
CLR00420 
CLR00430 
CLR 00440 
CLR00450 
CLR 00460 
CLR 004 70 
CLR00480 
CLR00490 
CLR 005 00 
CLR0051 0 
CLR 00520 
CLR00530 
CLR 00540 
CLR00550 
CLR 00560 
CLR00570 
CLR00580 
CLR00590 
CLR 006 00 
CLR0061 0 
CLR00620 
CLR00630 
CLR 00640 
ICLR00650 
CLR00660 
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GO  TO  999 

995  lERR-1 

URITE< I00UT,996) 

996  FORMAT<  1H0,20X,  76H***CLREA0  ERROR-**-*  NUMBER  OF  CUMULIFORM  CLOUDS 
♦NPUT  EXCEEDS  THE  LIMIT  OF  10 

CO  TO  999 

997  IERR=1 

WR1TE< I00UTt998> 

998  FORMRT<  1H0,20X,64H'*-*-*CLREAO  ERROR-*-*-*  IMPROPER 
■*NT  GO  SENTINEL  ) 

999  RETURN 
END 


INPUT  FORMAT  OR 


CLR00S7C 
CLR00680 
CLR00690 
ICLR00700 
CLR0071 0 
CLR00720 
CLR00730 
CLR00740 
ABSECLR00750 
CLR00760 
CLR0077CI 
CLR00780 
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SUBROUTINE  SCREENii  lERR ,  ICLHhT  >  SCROOOIO 

SCR00020 

THIS  MODULE  1 >  COMPUTES  TRPNSMl TTRNCE  REQUIRED  TO  REDUCE  THE  SCR00030 

PROBABILITY  OF  STATIC  TARGET  DETECTION  BELOU  A  SCR00040 

GIVEN  LEVEL  FOR  CERTAIN  TYPES  OF  IMAGERS.  <ITAM>  SCR00050 

SCR00060 

-  AND.^OR  -  SCR0u070 

SCR 00 OS 0 

2)  COMPUTES  HC  AND  UP  105  MM/155  MM  SMOKE  MUNITIONS  SCROOOSO 

REQUIRED  TO  PRODUCE  A  SMOKE  SCREEN  OF  USER-DEFINED  SCR00100 

LENGTH  AND  DURATION  FOR  VISIBLE,  NEAR.  MID  AND  FAR  SCR00110 
IR  WAVELENGTHS,  SCR00120 

SCR001 30 

SUBROUTINES  CALLED  BY  SCREEN  ARE  -  CWIC  AND  ITAM.  SCROOMO 

SCRuOl DU 

ALL  OUTPUT  FROM  SCREEN  IS  TABULAR.  SCR00160 

SCR001 70 

THE  PRESENT  VERSION  OF  CWIC  USES  THE  XSCALE  MODULE  TO  OPTIONALLY  SCR00180 

CORRECT  FOR  EXTINCTION  DUE  TO  FOG,  RAIN  AND/OR  SNOW  AT  IR  3CR001S0 

WAVELENGTHS  BASED  ON  VISIBILITY  IN  THE  .5  MICROMETER  REGION.  SCR00200 

CWIC  CAN  ALSO  COMPUTE  PASQUILL  CATEGORY  FROM  FUNDAMENTAL  MET  INPUTS  SCR0u210 
IF  THE  USER  CHOOSES  NOT  TO  PROVIDE  THE  CATEGORY  DIRECTLY,  SCR00220 

CLIMATOLOGICAL  VALUES  FROM  THE  CLIMAT  MODULE  CAN  OPTIONALLY  BE  SCR00230 

USED  AS  "TYPICAL"  MET  INPUTS,  SCR00240 

SCR00250 

THE  ITAM  MODULE  CAN  BE  USED  IN  A  LOOPING  MODE  THROUGH  MULTIPLE  SETS  SCR00260 
OF  INPUT  RECORDS  TO  GENERATE  TABLES.  THE  LAST  VALUE  OF  TRANS-  SCR00270 
MITTANCE  COMPUTED  IS  THAT  VALUE  WHICH  CAN  (OPTIONALLY)  BE  PASSED  SCR00260 
TO  CWIC  AS  THE  THRESHOLD  LEVEL  FOR  TOTAL  PATH  TRANSMITTANCE.  3CR002S0 

SCR00300 

TWO  RECORDS  MUST  BE  PROVIDED  TO  SCREEN:  3CRu0310 

ONE  CARD  MUST  BE  INPUT  TO  SCREEN  TO  SELECT  OPTIONS:  <3<1X,I1>>  SCR00320 

COL  2  ICITAM  -1  CALL  ITAM,  OR  0  < NO  CALL).  SCR00330 

COL  4  ICCWIC  -1  CALL  CWIC,  OR  0  < NO  CALL).  SCR00340 

COL  6  ICCLIM  -f  USE  CLIMAT  FOR  MET  INPUTS,  OR  0  USE  USER  VALUES,  SCR00350 

SCR003S0 

IF  CHOSEN,  ALL  INPUT  RECORDS  TO  ITAM  ARE  READ  FOLLOWING  THE  ABOVE  SCR00370 
RECORD.  (SEE  INPUT  DESCRIPTION  IN  ITAM>  SCR00380 

SCR003S0 

AND,  IF  CHOSEN,  INPUT  RECORDS  TO  CWIC  ARE  THEN  READ.  (SEE  INPUT  SCR00400 
DESCRIPTION  IN  CWIC)  SCR00410 

SCR 004 20 

FINALLY,  ONE  RECORD  IS  READ  BY  SCREEN  WITH  THE  WORD  "END"  IN  COLUMNS  SCR00430 
1-3,  THIS  RETURNS  CONTROL  TO  THE  EOSAEL  EXECUTIVE  MODULE.  SCR00440 

SCR00450 

COMMON  /lOUNIT/IOIN, lOOUT, IPHFUN, LOUNIT , NDIRTU, NCLIMT , KSTOR , NPLOTUSCR 00460 
READ  (lOIN.IO)  ICITAM, ICCWIC, ICCLIM  SCR00470 

FORMA T( IX, 1 1 , IX, 1 1 , IX, 1 1 )  SCR0048  0 

IF  (  ICITAM. HE. 0)  CALL  ITAM( lERR, TFNL )  SCR00490 

IF  (lERR.EQ.I)  GOTO  15  SCR00500 

IF  (  ICCLIM.  El'.  0)  GOTO  20  SCROuSIO 

IF  ( ICLMAT.EQ, 1  )  GOTO  20  3CR00520 

IERR=1  SCR00530 

WRITE  (IOOUT,30)  SCR00540 

FORMAT<  1X,62H«f>t>  IN  SCREEN  ROUTINE,  MET  SOURCE  SPECIFIED  AS  CLIMATSCR00550 
*0L0GICAL,/5X,39H8UT  CLIMAT  ROUTINE  HAD  NOT  BEEN  CALLED.)  SCR00560 

RETURN  SCR00570 

WRITE  ( lOOUT, 40)  SCR00580 

TFNL»1 .  SCR00590 

FORHAT( fX,21HIERR  FLAG  SET  IN  ITAM>  SCR00600 

IF  < ICCWIC. NE. 0)  CALL  CWIC  < lERR, ICITAM, ICCLIM, TFNL >  SCR0061 0 

RETURN  SCR00620 

END  SCR00630 


THIS  MODULE 


1)  COMPUTES  TRANSMITTANCE  REQUIRED  TO  REDUCE  THE 
PROBABILITY  OF  STATIC  TARGET  DETECTION  BELOW  A 
GIVEN  LEVEL  FOR  CERTAIN  TYPES  OF  IMAGERS.  (ITAM) 


-  AND/OR  - 

2)  COMPUTES  HC  AND  WP  105  MM/155  MM  SMOKE  MUNITIONS 
REQUIRED  TO  PRODUCE  A  SMOKE  SCREEN  OF  USER-DEFINED 
LENGTH  AND  DURATION  FOR  VISIBLE,  NEAR.  MID  AND  FAR 
IR  WAVELENGTHS, 

SUBROUTINES  CALLED  BY  SCREEN  ARE  -  CWIC  AND  ITAM. 

ALL  OUTPUT  FROM  SCREEN  IS  TABULAR, 

THE  PRESENT  VERSION  OF  CWIC  USES  THE  XSCALE  MODULE  TO  OPTIONALLY 
CORRECT  FOR  EXTINCTION  DUE  TO  FOG,  RAIN  AND/OR  SNOW  AT  IR 
WAVELENGTHS  BASED  ON  VISIBILITY  IN  THE  .5  MICROMETER  REGION. 

CWIC  CAN  ALSO  COMPUTE  PASQUILL  CATEGORY  FROM  FUNDAMENTAL  MET  INPUTS 
IF  THE  USER  CHOOSES  NOT  TO  PROVIDE  THE  CATEGORY  DIRECTLY, 

CLIMATOLOGICAL  VALUES  FROM  THE  CLIMAT  MODULE  CAN  OPTIONALLY  BE 
USED  AS  "TYPICAL"  MET  INPUTS, 

THE  ITAM  MODULE  CAN  BE  USED  IN  A  LOOPING  MODE  THROUGH  MULTIPLE  SETS 
OF  INPUT  RECORDS  TO  GENERATE  TABLES.  THE  LAST  VALUE  OF  TRANS¬ 
MITTANCE  COMPUTED  IS  THAT  VALUE  WHICH  CAN  (OPTIONALLY)  BE  PASSED 
TO  CWIC  AS  THE  THRESHOLD  LEVEL  FOR  TOTAL  PATH  TRANSMITTANCE. 

TWO  RECORDS  MUST  BE  PROVIDED  TO  SCREEN: 

ONE  CARD  MUST  BE  INPUT  TO  SCREEN  TO  SELECT  OPTIONS:  (3(1X,I1)) 

COL  2  ICITAM  -1  CALL  ITAM,  OR  0  (NO  CALL), 

COL  4  ICCWIC  -1  CALL  CWIC,  OR  0  (NO  CALL). 

COL  6  ICCLIM  -f  USE  CLIMAT  FOR  MET  INPUTS,  OR  0  USE  USER  VALUES, 


ICITAM 

ICCWIC 

ICCLIM 


IF  CHOSEN,  ALL  INPUT  RECORDS  TO  ITAM  ARE  READ  FOLLOWING  THE  ABOVE 
RECORD.  (SEE  INPUT  DESCRIPTION  IN  ITAM) 

AND,  IF  CHOSEN,  INPUT  RECORDS  TO  CWIC  ARE  THEN  READ.  (SEE  INPUT 
DESCRIPTION  IN  CWIC) 
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SUBROUTINE  CUIC  < lERR, ICITAM> ICCLIH, TFHL >  CUCOOOiu 

cure  COMPUTES  THE  REQUIRED  SMOKE  MUNITIONS  EXPENDITURE  < NUMBER,  CWC00020 

RATE  OF  FIRE,  PLACEMENT)  TO  PRODUCE  A  SCREEN  OF  DEFINED  CUC00030 

LENGTH  AND  DURATION  USING  HC  OR  UP  I 05MM  OR  fSSMM  SMOKE  CWC00040 

MUNITIONS.  WAVELENGTHS  ARE  FOR  RANGES  OF  VISIBLE,  NEAR,  CWCOuoDU 

MID  AND  FAR  IR.  CWC00060 

CWC00070 

ON  INPUT,  IF  ICITAM  IS  NON-ZERO,  ALL  COMPUTATIONS  WILL  USE  CWCOOOSO 

THE  INPUT  TFNL  AS  THE  TOTAL  SCREEN  TRANSMISSION  THRESHOLD.  IF  CWCOOOSO 
ICITAM  IS  0,  THEN  BUILT-IN  TOTAL  THRESHOLDS  OF  ,05  ARE  USED  CWCOOlOO 

FOR  ALL  WAVELENGTH  REGIONS.  CWC00110 

CWC00120 

INPUTS  TO  CUIC  ARE  OH  STANDARDIZED  RECORDS  CONTAINING  KEV-WORDS  CWC00130 

IN  COLUMNS  1-4  AND  REAL  <  IE  DECIMAL)  VALUES  FOR  ALL  INPUTS,  CWCOOMO 

PLACED  IN  FIELDS  11-20,  21-30,...,  71-80.  KEY-WORD  TYPES  CUC00150 

ARE  SCRN  FOR  SCREEN,  OBSERVER/TARGET  LOS  AND  ADVERSE  CWC00160 

WEATHER  CORRECTIONS.  CWC00170 

METR  FOR  METEOROLOGICAL  CONDITIONS  <MAY  BE  OMITTED  CWC00180 

IF  ICCLIM  IS  NON-ZERO,  IN  WHICH  CASE  THE  CWCuOlSO 

CLIMATOLOGICAL  VALUES  FROM  CLIMAT  ARE  USED.  CWC00200 

PASO  FOR  < OPTIONAL)  MET  PARAMETERS  REQUIRED  TO  COMPUTE  CWC0u210 
THE  PASQUILL  STABILITY  CATEGORY.  NOT  REQUIRED  CWC00220 
IF  PASQUILL  CATEGORY  ITSELF  IS  INPUT.  CWC0023U 

DONE  WHICH  RETURNS  EXECUTIVE  CONTROL  BACK  TO  THE  SCREEN  CWC00240 
MODULE.  CWC0025U 

ewe 00260 

THE  ORDER  OF  THE  INPUT  RECORDS  IS  IMMATERIAL,  EXCEPT  THAT  THE  < DONE >  CWC00270 
CARD  MUST  BE  LAST.  CUC00280 

CWC002S0 

INPUTS!  <ALL  VALUES  REAL)  FORMAT  < 2A2, 6X, 7F 1 0 . 3 )  CWC00300 

CWC0031 0 

KEYWORD  COLS.  VARIABLE  DESCRIPTION  CWC00320 

-  -  -  - - — - - - - CWC00330 


INPUTS! 

KEYWORD 


VARIABLE 


1-4 

>1-20 

21-30 

31-40 

41-50 

51-60 

61-70 

71-80 


8CREEN7L0S  DEFINITION  (REQUIRED)  CWC00340 

-  SCREEN  DURATION  (MINUTES)  CWC00350 

-  SCREEN  LENGTH  (METERS)  CWC00360 

-  SLANT  RANGE  OBS-TARGET  (KM)  CWC00370 

-  ELEVATION  ANGLE  OF  TARGET  FROM  CWC00380 

OBSERVER  WRT  HORIZONTAL  (DEG.)  CWC00390 

-  COMPASS  DIRECTION  (CLOCKWISE  WRT  CWC00400 

NORTH)  OF  LINE-OF-SIGHT  (DEG.)  CWC00410 

-  TERRAIN  ROUGHNESS  ELEMENT  (CM)  CWC00420 

-  ADVERSE  WEATHER7HAZE  SELECTION  CWC00430 

0.  *  NO  ADVERSE  WEATHER  CWC00440 

1.  «  ONLY  CORRECT  VISIBLE  WAVE-  CWC00450 
LENGTHS  FOR  INPUT  VISIBILITY .CWC00460 


CORRECT  FOR  FOG/HAZE  FOR  CWC00470 

MARITIME  ARCTIC  AIR  MASS  CWC00480 
CORRECT  FOR  FOG/HAZE  FOR  CWC00490 

MARITIME  POLAR  AIR  MASS  CUC00500 

CORRECT  FOR  F0G7HA2E  FOR  CWC00510 

CONTINENTAL  POLAR  AIR  MASS  CWC00520 


11-20 

21-30 

31-40 


41-50 

51-60 

61-70 


5.  «  CORRECT  FOR  RAIN.  CWC00530 

6.  -  CORRECT  FOR  SNOW.  CWC00540 

CWC00550 

MET  INPUTS  (NOT  REQUIRED  IF  ICCLIM  CWC00560 
HON-ZERO  FROM  SCREEN  MODULE.)  CWC00570 

-  WINDSPEED  (METERSXSEC)  CWC00580 

-  WIND  DIRECTION  (DEG)  CLOCKWISE  CWC00590 

WRT  NORTH,  USUAL  MET  CONVENTION  CWC00600 

-  PASQUILL  CATEGORY.  IF  INPUT  AS  0.  CWC006IO 

SEE  PASQ  RECORD  BELOW.  OTHERWISE,  CWC00620 
1.*A,  2,»B,  3.=C,  4.-D,  5.»E,  6 . =F  CUC00630 
VISIBILITY  (KM)  NOT  REQUIRED  IF  CWC00640 

FOG  -  0.  IS  SPECIFIED.  CWC00650 

RELATIVE  HUMIDITY  (PERCENT).  IF  0.,CWC00660 
THEN  DEW  POINT  AND  TEMPERATURE  ARE  CWC00670 
REQUIRED  BELOW  TO  COMPUTE  RO.  CUC00680 

AIR  TEMP.  (DEG  C)  REQUIRED  IF  RO  NOCUC00690 
GIVEN.  CUC00700 
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V 


PASO 


OOHE 


71-80 

T1 

1-4 

11-20 

SLAT 

21-30 

SLOHG 

31-40 

SJDATE 

41-50 

SZHOUR 

51-60 

CO 

61-70 

1-4 

ct 

-  DEW  POINT  TEMP.  <DEC  Ci  REQUIRED  IPCWC007lu 

RO  NOT  GIVEN.  CWC00720 

CWCOO/30 

PASQUILL  CATEGORY  DETERMINATION  <REQUICWC00740 
RED  ONLY  IF  PCAT  ABOVE  IS  0.  >  CWC0u75u 

-  LATITUDE  OF  SITE  <DEG,).  POSITIVE  ICWC00760 


NORTH  LATITUDE. 

-  LONGITUDE  OF  SITE  < DEC .  ) ,  POSITIVE 
EAST  LONGITUDE. 

-  JULIAN  DATE.  CDECIMAL  DAYS > 

-  GMT  TIME  OF  DAY  < DECIMAL  HOURS  AND 
FRACTIONAL  HOURS) 

CEILING  CLOUD  HEIGHT  (METERS; 

-  CLOUD  COVER  (PERCENT; 

END  OF  CWIC  EXECUTION  (REQUIRED) 


ALL  OUTPUT  FROM  CWIC  IS  TABULAR. 
CUIC1 ,  CWIC3,  CWIC4,  JPASCT^ 


SUBROUTINES 
X3CALE . 


CALLED  APE  - 


CWCIj0770 
CWC00780 
CWC00790 
CWC00800 
CWCOObI 0 
CWC 00620 
CWC 00630 
CWC u 0840 
CWC0065U 
CWC 00660 
CWC 00670 
CWC00880 
CWC006SU 
CWC00900 
CWC0091 0 
CWC0C920 


IR> 


1  0 


DIMENSION  CS(4,2>,TRSH<4),UAVE(4),  ISLANT(  4),  IR(8  ), 

•*H<  2, 2  >  ,  U<  2, 2  ).  LNGTH<  16),  lSMOt<E<  2  ),  IGUN<  4  >,  JANS(  4  ) 

COMMON  /lOUNITXIOlN, lOOUT, IPHFUN,  LOUNIT , ND I RTU , NCL 1 MT , KSTOR , NPLOTUCWC 0093 
COMMON  /GEOMETXPTS< 15), IGEOSW  CWC00940 

COMMON  /'CLYMAT/  TEMP , PRESS , RH, AH, DP , VIS , CLDAMT , CLDHYT , FOGPRB , 
■*WNDVEL.WNDDIR,  IPASCT 

COMMON  /n06/  P<4,2,2>,01<4,2,2),Q2<4,2,2),Y<4,2,2>,Z<4,2,2), 

•  C<  4 , 2  ) , R<  4 , 2  ) , V<  2  > , RV<  7),T<4),ARE,C0,C1,C2,D0,D2 
OLS,RO,R2,SO,S3,SJOATE,SLAT,SLONG,S2HOUR,TIME, 

*  TR<4>,X0,  Y1  ,  IT<2),  IPO,  IDUMMY 
COMMON  /CONST/  PI , PI 2, PIRAD, TWOPI , TORRMB, CDEGK 
EXTERNAL  JPASCT 

DATA  IR/2HSC, 2HRN, 2HME, 2HTR, 2HPA,2HbQ, 2HD0, 2HNE/ 

DATA  H  /18. 7, 77. 1 , 1737.3,7076.2/ 

DATA  U  /S.4,7.9, 1 .8,2.6/ 

DATA  LNGTH  /2HV1 , 2HS1 , 2H8L , 2HE i , 2HNE, 2HAR, 2H  I,2HR!,2HM1, 

■»2HD  ,2HIR,2H!  ,2HFA,2HR  ,2H1R,2H:  / 

DATA  JANS  /2HN0,2H  ,2HYE,2HS  / 

DATA  I  SMOKE  /2HHC,2HWP/ 

DATA  IGUN  /2H10,2H5  ,2H15,2H5  / 

INITIALIZE  VALUES  FOR  DEFAULTS. 

EXTINCTION  COEF  HC  < VIS ,, NEAR, MID, FAR >,  WP  < V I S . , NE AR , M I D , FAR 
DATA  CS  /3. 3, 1 .5, 0.53, 0. 13,2.46,2. 0, .25, .32/ 

BUILT  IN  TRANSMISSION  THRESHOLDS,  WAVELENGTHS,  XSCALE  SLANTS 
DATA  TRSH  /.OS,  .05,  .05,  .05/ 

DATA  WAVE  / . 55, 1  . 06 , 3 . 5, 1 0 . 6/ , ISLANT/0,  1 , 1  ,  1 / 

ACOS<  ARG )=ATAN2<  SQRT< 1 . -ARG**2 ) , ARG  ) 

TIME=1 0. 

X0=1 000. 

H3=3. 

AST=0 . 

DLS=90, 

ARE»1  . 

FOG-0. 

S3=4. 

D0=0. 

PCAT-3, 

R0=50. 

T0=24. 

T1-12.94 
VS-1 0. 

READ  DATA  CARDS 
ICOU=0 

READ  <IOIN,900>  IT<  1  >,  IT<  2  ),  <  RV<  I  ),  I«=l ,  7  > 

ICOU-ICOU+1 

■  ‘  IR<1 >.AND,1T<2).EQ.1R<2>>  GOTO  20 

1R(3>.AND.IT<2>.EQ.IR<4>;  GOTO  40 

_ _ IR<5).AND, IT<2).EQ. IR<6)>  GOTO  50 

IF  <IT<1 ).EQ.IR<7).AND.lT<2>.EQ.IR(d)>  GOTO  60 
WRITE  <IOOUT,901>  IT< 1 ), IT< 2 >, < RV< I ), 1*1 , 7 > 

255 


IF  ( IT< 1  ).EQ. 
IF  < IT< 1 >,EQ. 
IF  < IT< 1 ),EQ. 


CWC00950 
CWC00960 
CWC00970 
CUC00980 
CWC00990 
CUC01 000 
CWC01 01 0 
CWC 01 020 
CWCOi 030 
CWC01 040 
CWCOI 050 
CWCOI 060 
CWCOI 070 
CWCOI 080 
CWCOI 090 
CWCOI 1 00 
CWCOI 1 1 0 
CWCOI 120 
CWCOI 130 
CWCOI 140 
CWCOI 150 
CWCOI 160 

CWCOI 170 
CWCOI 180 
CWCOI 190 
CWCOI 200 
CWC0121 0 
CWCOI 220 
CWC01230 
CWCOI 240 
CWCOI 250 
CWCOI 260 
CWC 01 270 
CWCOI 260 
CWC 01 290 
CWCOI 300 
CWC0131 0 
CWC 01 320 
CWC01330 
CUC01340 
CUC01350 
CWC0t360 
CWC01370 
CWCOi 360 
CWCOI 390 


i. 

•  I 


900 

FORMAK  2A2 , 6X ,  7F 1  0 . 3  > 

CWC01400 

901 

FORMAK 1X,51HIN  CWIC,  THE  FOLLOWING  CARD  DOES  NOT  CONFORM  TO  PRO. 

CWC0141 0 

♦  15HPER  C0NVENTI0NS/'1X.2A2.6X,7F1  0.3> 

CUC01420 

IF  < IC0U.LE.4>  GOTO  10 

CWC01430 

WRITE  < IOOUT,902> 

CWC01 440 

902 

FORMAT< 1X,39HINVAL1D  INPUTS  TO  CWIC.  lERR-1  RETURNED) 

CWC01450 

IERR=1 

CUC01460 

RETURN 

CWC01 470 

20 

TInE=RV< 1 > 

CwCOf 480 

X0=RV<2) 

CUCOI 490 

H3=RV<3> 

CWC01 500 

AST=RV<4> 

CWCOtSI 0 

DLS*RV<  5  ) 

CuCOi 520 

ARE=RV<6) 

CWCCi153Ct 

F0G=RV<  7  > 

CUCOI 540 

IF< IGEOSW.NE. 1 >  GO  TO  22 

DELX-PTS< 1 >-PTS<4) 

CWC01550 

CUCOI 560 

DELY=*PTS<2>-PTS<5) 

CUC01570 

DELZ=PTS<3>-PT3<6> 

CUCOI 580 

H3=SQRT<  0ELX*-*2+DELV<**2+DELZ-**2  ) 

CUCOI 590 

HD  I5=seRT<  DELX-»*2+DELY**2  > 

CUCOI 6O0 

RTDC0N=57. 29577951 

CUCD161 0 

AST=RTDC0N*AC0S<HDIS/H3 3 

CUCOI 620 

IF<HDIS.GT. 1 .E-20)  DLS-RTDCON*ACOS< OELY/HOIS > 

CUCOI 630 

IF<DELX,LT. 0. )  DLS-360.-DLS 

CUCOI 640 

22  CONTINUE 

CUC01650 

GOTO  10 

CUCOI 660 

40 

S3=RV< 1 > 

cue 01 670 

D0=RV<23 

CUCOI 680 

PCAT=RV<3) 

CUC01690 

VS=RV<4) 

CUC01700 

R0=*RV<5:> 

CWC0171 0 

T0=RV<6:) 

CUCOI 720 

T1=RV<7) 

cue  01 730 

GOTO  10 

CUCOI 740 

50 

SLAT=RV< 1  ) 

CWC01750 

SL0NG«RV<2> 

CWC01760 

SJDATE=RV<3> 

CWC01770 

SZH0UR=RV<4) 

CWC01780 

C0=RV<5) 

CWC01790 

C1-RV<  6  ) 

CUC01800 

GOTO  10 

cucotei 0 

c<*** 

BEGIN  COMPUTATIONS.  —  FIRST  MET  VALUES. 

CUC01820 

60 

IF  < ICCLIM.EQ. 0)  GOTO  70 

CUC01830 

USE  CLIMAT  PASSED  VALUES; 

CUCOI 840 

TO-TEMP 

CUC01850 

T1=DP 

CUC01860 

R0=RH 

CUCOI 870 

PCAT»FLOAT< IPASCT) 

CUC01880 

VS=VIS 

CUC01890 

D0=WNDDIR 

CUC01900 

S3>WNDVEL 

CUC0191 0 

PROVIDE  WINOSPEED  IN  KNOTS  AS  SO; 

CWC01920 

70 

SOaSS/.SIS 

CUC01930 

IF  <S0,LE. 1 . )  S3-. 515 

CUC01940 

IF  <S0,LE. 1 . >  SO-1  . 

NOW  CHECK  RH  AND  COMPUTE  IF  NECESSARY. 

CWC0I950 

C**"* 

CUC01960 

IRNOT-0 

CWC01970 

IF  <R0.GT. 0. )  GOTO  80 

CUC01980 

IF<T0  .GT.  0. >  GO  TO  76 

CUCOI 990 

AO-9.5 

CUC02000 

BO-265.5 

CUC0201 0 

IF<T0  .LE.  0. >  GO  TO  78 

cue 02020 

76 

CONTINUE 

CUC02030 

AO-7.5 

CUC02040 

BO-237.3 

CUC02050 

78 

CONTINUE 

cue 02 060 

IF<T1  .GE.  0. >  GO  TO  79 

cue 02070 

A1-9.5 

CUC02080 

81-265.5 
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CWC02090 

I 


75 


30 


,  **<  <  AO+TO  >/<  BO+TO ) > 
>/’<B1+Tl  >> 


c+f* 

C 

c 

90 


IP<T1  .LE.  u.>  GO  TO  75 
CONTINUE 
A1=7.5 
Bl=237.3 
CONTINUE 
E0=6 .11*10 
E1=6 , 1 1*1 0 
R0=<E17E0>*1  00 
IRHOT=1 

NOW  CHECK  PASC'UILL  CATEGORY.. 

IP0=IFIX( PCAT+ . 001  > 

IF  <  IP0.GT.6>  IP0=6 
IPHOT=0 

IF  < IPO.GT, 0>  GOTO  90 

CALL  CWIC1  f.  IPO,  CO,  Cl  ,  SLAT,  SLONG,  S  JDATE,  S2H0UR,  SO  > 

IPNOT=1 

CL  VALUE  FOR  THRESHOLD  TRANSMITTANCE,  CORRECTED 


NEXT  COMPUTE 
FOG, RAIN, 

VISIBILITY  EXTINCTION 


FOR 


)  EX55=3.9127VS 
THRESHOLDS . . 


0>  T<  I  >>«TFNL 


<KM-1>  .,  NOTE  THAT  IF  VS=0.,  THEN  SET  TO 
CLEAR  DAY  AND  COMPUTATIONS  CONTINUE. 

EX55=0 . 

IF  < VS.GT. 0, 

C***  TRANSMISSION 
DO  92  1=1,4 
T< I >=TRSH< I > 

IF  < ICITAM.NE. 

TRC  I  )=T<  I  ■> 

92  CONTINUE 

C***  CORRECTIONS  FOR  WEATHER 
IFOG=-1+IFIX<FOG*. 0001 > 

IF  < IFOG.LE.-1 )  GOTO  1  00 

C***  CORRECT  VISIBLE  FOR  VISIBILITY  <H3  SLANT  RNG,  AST  ELEV.  ANG ,  ) 
XSTRN-0. 

EPTH=EX55*H3 

IF  (EPTH.LT. 12. )  XSTRH=EXP< -EPTH ) 

C  SET  VSET  FOR  NO  CARD  \/0  IN  XSCALE 
VSET=89. 

IF<< AST.GT. 0, 1  .OR.  AST . LT . -0 . 1 > . AND . IFOG . LT . 5 > 

♦CALL  XSCALE<WAVE< 1  >,VSET,EX55,XSTRN, lERR, ISLANT< 1  ), IFOG, H3, AST > 
IF  (XSTRN.LE. 0, )  XSTRN=,0001 
IF  <XSTRN.GT. 1 . >  XSTRN=1 . 

T< 1  )=T< 1  J/XSTRN 
IF  <IFOG,ECi.O)  GOTO  100 
C  CORRECT  NON-VISIBLE  FOR  SEEABILITY, 

94  CONTINUE 

DO  96  1=2,4 
I3LNT=ISLANT< I ) 

IF  <AST.EQ.O.  )  1SLNT=0 
IF  < IF0G.GE.5 j  ISLNT=0 

CALL  XSCALE<WAVE< I  ) , VSET , EX55 , XSTRN, lERR, I3LNT, IF0G,H3, AST> 

IF  <XSTRN.LE. 0. )  XSTRN=.0001 
IF  <XSTRN,GT. 1 .  )  XSTRN=1 . 

T< I >=T< I ^XXSTRN 
96  CONTINUE 

C***  COMPUTE  CL  FOR  THRESHOLD  TRAHSMISSION  REQUIRED  OF  SMOKE. 

100  DO  lOe  1=1,4 

IF  <  T< 1 >.GT. 1 .  )  T< I )=1 . 

IF  <T<I).LE.0.)  T<I>=, 00001 
DO  105  J=1,2 

C< I, J>=ALOG<T< I ))/<-CS< I,  J>> 

105  CONTINUE 
108  CONTINUE 
C***  ATMOSPHERIC  DIFFUSION 

CALL  CW1C3  <ARE,DLS,C2,O0,D2,H,IP0,R0,R2,U,V,Y1 > 

C***  MUNITIONS  EXPENDITURES 

CALL  CWIC4  <C.C2,02,H,P,Qt ,a2,R,R2,S3,TIME,V,X0,Y,Y1 ,2, IPO) 

C**  END  MAIN  CUIC  COMPUTATIONS,  FINAL  OUTPUT. 

IF< ICITAH.GT. 0>  WR1TE< lOOUT, 10000) 

WRITE  < lOOUT, 1 0200) 

WRITE< lOOUT, 1 0800) 


CWC021 00 
CWC021 i 0 
CWC02 1 20 
CWC021 30 
CWCu21 40 
CUC021 50 
CWC021 60 
CWC021 70 
CWC02130 
CWC021 90 
CWC02200 
CwC0221 0 
CwC 02220 
CWC 02230 
CWC 02240 
CWC 02250 
CWC  0226  u 
CWC 02270 
CWC02230 
CWC02290 
CuC02.500 
CWC0231 0 
CWC 02320 
CWC 02330 
CWC02340 
CWC 02350 
CWC 02360 
CWC02c570 
CWC02330 
CWC02390 
CWC 024 00 
CWC  024 1  0 
CUC02420 
CWC02430 
CWC02440 
CWC 02450 
CWC 02460 
CWC 02470 
CWCD2430 
CWC 025 00 
CWC0251 0 
CWC02520 
CWC02530 
CWC02540 
CWC02550 
CWC02560 
CWC02570 
CWC  025-90 

CWC02590 
CWC0261 0 
CWC 02620 
CWC 02630 
CWC02640 
CWCu2650 
CWC 02660 
CWC 02670 
CWC 02680 
CWC02690 
CWC 027 00 
CWC0271 0 
CWC02720 
CWC02730 
CWC02740 
CUC02750 
CWC02760 
CWC02770 
CWC02780 
CWC02790 
CWC02800 
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WRITE  < lOOUT, 1 0140> 

URITE< lOOUT, 1 0300) 

WR1TE<  IOOL1T,  1  0400) 

WPITE< lOOUT,  t  0200) 

WRITE  < lOOUT, 14000)  H3 
WRITE  < lOOUT, 141 00)  AST 
WRITE  < lOOUT, 14200)  DLS 
WRITE  ■:  lOOUT,  1  1900)  ARE 
WRITE  < lOOUT, 1 1400) 

IAD=1 

IF  <;  IFOG.CE.  0)  IAO=3 

WRITE  <  lOOUT,  14300)  JANS<  IAt>  >,  JAHS<  lAO+l  > 
1AD=1 

IF  <  IFOG.EQ.  1  )  IA0=«3 

WRITE  <  I  GOUT,  14400)  JANS<  lAO  ),  JANS<:  1 AD+1  ) 
IAD=1 

IF  < IFOG.EQ. 2)  IAO-3 

WRITE  < lOOUT, 14500)  JANS< lAD ), JANS< IAD+1 > 
IAD=1 

IF  < IFOG.EQ. 3)  I AD-3 

WRITE  <  lOOUT  .  MbOO)  JAHS<  I  AD  ),  JANS<  lAD-M  > 
IAD=1 

IF  i IFOG.EQ. 4)  IAD=3 

WRITE  UOOUT,  14700  )  JANS<  I  AD  ),  JANS<  I AD+1  ) 
1AD=1 


IF  < IFOG.EQ. 5)  IAD=3 

WRITE  < lOOUT,  14800)  JANS< I  AD ), JANS< IAD+1 > 

WRITE  < lOOUT, 15000) 

WRITE  < lOOUT, 1 1800)  S3 
WRITE  < lOOUT, 1 1700 )  DO 
JP=JPASCT< IPO) 

WRITE  < lOOUT, 12000)  JP 

WRITE  < lOOUT, 1 1300)  VS 

WRITE  < lOOUT, 12100)  RO 

IF  (IRNOT.EQ.I)  WRITE  < lOOUT, 1 1 500 )  TO 

IF  (IRNOT.EQ.I)  WRITE  < lOOUT, 1 1 600 >  T1 

IF  < IPNOT.EQ. 0)  GOTO  120 

WRITE  <IOOUT, 15100) 

IF  (SLAT.GE.O.)  WRITE< lOOUT, 1 0601 )  SLAT 
SLATl—SLAT 

IF  (SLAT.LT. 0.  )  WRITE< lOOUT, 1 0602 )  SLATI 
IF  (SLONG.GE. 0. )  WRITEC lOOUT , 1 07 01 )  SLONG 
SLONGI—SLONG 

IF  < SLOHG.lt. 0.  )  WRITE< lOOUT,  1 0702)  SLONGI 
WRITE< lOOUT, 1 0900)  SJDATE 
WRITE< lOOUT, 1 1 000)  SZHOUR 
WRITE< lOOUT, 11100)  CO 
WRITE< lOOUT, 11200)  Cl 
120  CONTINUE 

WRITE  < lOOUT. 15200) 

DO  150  1=1,4 
IWL=4>«'<  1-1  ) 

WRITE  < lOOUT, 15300)  < LHGTH< IWU+ J ), J=1 ,4 ), TR< I ) , T( I ) 

150  CONTINUE 

URITE< lOOUr, 1 0000) 

C*  PRINT  MUNITION  EXPENDITURES 
WRITE< lOOUT, 1 0130) 

WRITE< lOOUT, 16200)  <LNGTH<  J), J=1 ,8) 

WRITE< lOOUT, 10100) 

WRITE< lOOUT, 16300) 

WRITE< lOOUT, 16400)  XO, TIME, XO, TINE 
WRITE< lOOUT, 1 0200) 

WRITE< lOOUT, 16500)  ISMOKE< 1 ), ISMOKE< 1 > 

WRITEdOOUT,  I  Of  00) 

WRITE< lOOUT, 16600)  IGUH< 1 >, IGUN< 2 >, IGUN< 1 ), IGUH(2) 

WRITE< lOOUT, 10100) 

WRITE< lOOUT, 16700) 

WRITE< lOOUT, 16800) 

WR1TE< lOOUT, 16900)  Q1 < 1 , 1 , 1 ), Y< 1 , 1 , 1 >- 01 < 2, 1 , 1 ), Y< 2 , 1 , 1 ) 

WRITE< lOOUT, 17000)  Q1 < 1 , 2, 1 ), R< 1 , 1 ), Y< 1 , 2, 1 ), P< 1 , 1 , 1 ), Q 1 < 2 , 2 , 1 ) , 


CWC0281 0 
CWC02820 
CWC02830 
CWC0284CI 
CWC02850 
CWC02860 
CWC02870 
CWC 02880 
CWC02890 
CWC02900 
GWG029i 0 
CWC 02920 
CWC02930 
CWC 02940 
CWC02950 


CWC02960 
CWC02970 
CWC02980 
CWC02990 
CWC 03000 
CWC0301 0 
CWC03020 
CWC03030 
CWC 03 040 
CWC03050 
CWC03060 
CWC03070 
CWC 03 080 
CWC03090 
CWC031 00 
CWC 031 1 0 
CWC 03 120 
CWC03130 
CWC03140 
CWC03150 
CWC 03 160 
CWC03170 
CWC03180 
CWC03190 
CWC03200 
CWC0321 0 
CWC03220 
CWC03230 
CWC03240 
CWC03250 
CWC03260 
CWC03270 
CWC03280 
CUC03290 
CWC 03300 
CWC0331 0 
CWC03320 
CWC03330 
CWC03340 
CUC03350 
CWC 03360 
CWC03370 
CWC03380 
CWC03390 
CWC03400 
CWC 0341 0 
CWC 03420 
CWC03430 
CWC03440 
CWC03450 
CWC03460 
CWC 03470 
CWC03480 
CUC03490 
CWC03500 


i 


Qi<  1 , 1 ,2),y<  1 

Q1(  1 ,2.2),R<  1 
} 


t,2).Q1<2,  !  .2>,  y< 

1  >>Y<  1 ,2,2>,P<  1 ,2 


>*R<2, 1  >,V<2,2,  i  j,P<2,  i  ,  1  J 
WRITE< lOOUT, 1 0200) 

URITE< lOOUT, t6600)  IGUN<3), 1GUN< 4 IGUN< 3 )^ 1GUH< 4 > 
URITE< lOOUT,  I Ot  00) 

URITE< lOOUT,  16700) 

WRITEC lOOUT. 16800) 

WRITE< lOOUT, 16900) 

U)RITE<  lOOUT.  1  7000) 

*R<2,1  ),y<2,2.2),P<2,2.  1 
UIRITE<  lOOUT,  t  0200) 

URITE< lOOUT, 16500)  ISM0KE<2>, ISM0KE<2) 

WRITE< lOOUT. 10100) 

U)RITE<  lOOUT,  1660  0)  IGUH<  1  ),  IGUH<2  ),  IGUN<  1  >,  1GUN<  2  ) 
URITE< lOOUT, 10100) 

URITE< lOOUT, 1 6700 ) 

WRITE< lOOUT, 16800) 

WRITE< 10007, 16900) 

1F< IPO  , GT .  4 )  R<  1 


2,  1.2> 

.  1  ).Q1<2.2.2), 


Q2<  1 

.2)=2 

IF<1P0  .GT.  4)  R<2,2)=2. 

WRITEC lOOUT, 1  7  000  )  Q2< 1 , 2 , 1  ) , R< 1 , 2 ) , 2< 1 
*R<  2,2),2<2. 1  ,  1  ),P<2,  1 ,2) 

WRITE<  lOOLIT,  1  0200) 


1 .  1  )>Z<  1  .  1  ,  1  ),Q2<2,  1  ,  1  ).2(2,  1  ,  1  > 

,2),Q2<2,2,  1  ), 


1  ,  1  ),P<  1  ,  1 


WRITE< lOOUT, 16600) 
WRITE< lOOUT, 1 01 00) 
WRITE< lOOUT, 16700) 
UR1TE< lOOUT, 16800) 
UR1TE< lOOUT,  16900) 
IF< IPO  .GT.  4)  R< 1, 


1GUN<  3 ), IGUN<  4 ), IGUN<  3  ), IGUN<  4  ) 


1 ,2),2<  1,2,2>,Q2(2,  1,2),2<2,2,2) 

,2),Q2<  1,2,2), 


Q2<  1 

.  - ,  2 )= 1  . 

IF< IPO  .GT.  4)  R<2,2>»1 , 

UIRITE<  lOOUT,  17  000)  Q2<  1 , 2 , 2  ),  R<  1 , 2  ),  2<  1 , 2, 2  ) ,  P<  1 , 2 
*R<2,2),Z<  2,2,2),P<2,2,2) 

WRITE< lOOUT, 1 0000) 


WRITE  < lOOUt, 1 0130) 

00  7100  1«3,4 
IUL=4*< I-l  ) 

J1=IWL+1 

J2=IUL+4 

WRITE  <  lOOLlT,  12200)  <LNGrH<  J>,  J»  Jf ,  J2) 
WRITE  < lOOUT, 1 01 00) 

WRITE  < lOOUT, 12300) 

WRITE  < lOOUT, 12400)  X0,TI«E 
WRITE  < lOOUT, 1 0200) 

WR1TE< lOOUT, 1 2500 ) 

WRITE< lOOUT, 1 01 00) 

WRITE< lOOUT, 131 00) 

WR.ITE<  lOOUT,  13200) 

WRITE< lOOUT, 13300) 

WRITER lOOUT, 13300) 

IF  < I ,EQ.3)  - 

IF  <  I  .EQ.4) 

7100  CONTINUE 
RETURN 

C*  FORMAT  STATEMENTS. 

10000  FORMAT< IHl ) 

FliRMAT<1H  ) 

FORMAT< 1H0) 

F0RMAT<//7) 

FORMAT< ////) 

FORMAT<  55X , 2 1 HMUNI T I ON  EXPEND I TURES  > 
F0RMAT<56X, 19HF0R  HC  AND  WP  SMOKE) 


ISM0KE<2) 


IGUN<  1  ),  ICUN<2),Q2<  1,2, 1  ),R<  1,2 
IGUN<3),  IGUN<4  >,C12<  1 ,2,2  ),R<  I,  2 
WRITER lOOUT, 1 0140) 

WRITE<IOOUT, 10000) 


),P<  I,  1 ,2) 
),P<  1,2,2) 


10100 
1  0200 
1  0130 
1014  0 
1  0300 
1  0400 
1  0601 
1  0602 
1  07  01 
1  0702 
1  0800 


FORMAT<45X,35HLATITUDE 
FORMAT*:  45X,35HLAT1TUDE 
F0RMAT<45X,35HL0NG1TU0E 
F0RI1AT<45X,35HL0NGITU0E 

F  ORMAT  ^  1H0,47X,36^  1H*l')X48X,,n-,',  ,  t  ~f9r\  ,  -rr*, 

♦  26HCWIC  MUNITION  EXPENDITURES ,  4X,  1  Ht>/48X,  1 H*  ,  34X ,  1 
^48X  36^  1  H4>  ) 

10900  F0RMAT<45X,35H JULIAN  DATE  -  DAY 

11000  F0RMAT<45X,35HGMT  TIME  -  HOUR 

11100  F0RMAT<45X,35HCEIL1NG  -  METERS 


-  DEC 

-  DEG 

-  DEG 

-  DEG 

1H*,34X,  lHfX48X,  lHi',4X, 


F7.2,6H  NORTH) 
F7.2,6H  SOUTH) 
F7.2,6H  EAST  ) 
F7,2,6H  WEST  ) 

Hm/ 

F7, 0) 

F7.2) 

F7 . 1  ) 


CUC0331 0 
CWC03520 
CWC03530 
CWC03540 
CWC 03550 
CWC  035e  0 
CWC03570 
CWC 03580 
CWC03590 
CWC03600 
CWC0361 0 
CWC03620 
CUC03630 
CWC03640 
CUC03650 
CWC03660 
CUC03670 
CWC03680 
CWC03690 
CWC03700 
CUC0371 0 
CWC03720 
CUC03730 
CWC 03740 
CUC03750 
CWC03760 
CWC03770 
CWC037eo 
CWC 03790 
CWC 038 00 
CWC0381 0 
CWC03820 
CWC03830 
CWC03e40 
CWC03850 
CWC 03860 
CWC03870 
CWC 03880 
CWC03890 
CWC03900 
CWC 0391 0 
CWC03920 
CWC03930 
CWC03940 
CWC03950 
CWC03960 
CWC03970 
CWC03980 
CWC 03990 
CWC04000 
CWC0401 0 
CWC 04 020 
CWC 04 030 
CWC 04 040 
CWC04050 
CWC 04 060 
CWC 04 070 
CWC 04 080 
CWC04090 
CWC 041 00 
CWC041 1 0 
CWC04120 
CWC04130 
CWC04140 
CWC04t50 
CWC04160 
CWC04170 
CWC04130 
CWC04190 
CWC04200 
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i 


11200 
1  1  300 
11400 
11500 
11600 
11700 
11800 
11900 
12000 
12100 
12200 
12300 
12400 
12500 
12600 
12700 
12800 
12900 
13000 
131  00 
13200 
13300 
14000 
14100 
14200 
14300 
14400 
14500 
14600 
14700 
14300 
15000 
15100 
15200 
15300 
16200 

16300 

16400 

16500 

* 

16600 

16700 

16800 

16900 

17000 


PERCENT 

=,F7. 1  > 

KM 

=,F7.3) 

ON  CORRECTIONS  ) 

DEG  C 

=  ,F7. 1  ) 

DEG  C 

=  ,F7 . 1  ) 

DEC 

=,F7 .2) 

M/SEC 

=,F7,2) 

CM 

=  ,F7, 1  ) 

=,5X, A2) 

PERCENT 

=  ,F7. 1  ) 

F0RMAT<45X,35HCL0UD  COVER 
F0RMAT<45X.35HVIS1BILITY 
FORMAT< 1HO,44X,35HATMOSPHER1C  EXTINC 
F0RM8T<  45X, 35HTEMPERPTURE 
F0RMAT<45X.35HDEW  POINT 
F0RMAT<45X,35HUIN0  DIRECTION 
F0RMftT<45X,35HWINDSPEED 
F0RMAT<45X.35HAVG  ROUGHNESS  ELEMENT 
F0RMAT<45X,35HPASQUILL  CATEGORY 
FORMAT< 45X,35HRELATIVE  HUMIDITY 

FORMATCeOX, 1 1 < 1 H- J/S OX , 1 H- . 1X,4A2, 1H-/60X, 1 1< 1 H- ) > 

FORMAT<  62X, 6HLENGTH, 8X, 8HDURATI0H/62X. 6HMETERS. 9X, 7HMINUTES  > 
FORMAT<  47X , 6HSCREEN , 8X , F7 . 0 . 9X , F7 , 2 ) 

F0RMAT<59X.A2, 13H  SMOKE  SCREEH/59X, 1 5< 1 H- >  ) 

F0RMAT<59X,A2, A1 , 1 1HMM  HOWITZER) 

F0RMAT<47X,37HV0LLEY  GUNS  RATE  SPACING  ROUNDS) 

FORMAT< 47X,30H  /MIN  METERS) 

F0RMAT<47X, 1 IHINITIAL:  , F5 , 0, 6X , F8 . 0 > 

F0RMAT<47X, 1 1HSUSTAINING i < F5 . 0, F5 . 1 , F9 . 0 ,  F7 . 0 ) 

FORMAT< 47X, 31H  ROUNDS/  RATE/  TOTAL) 

F0RMAT<47X,32H  60  METERS  MINUTE  ROUNDS) 

F0RMAT<47X, A2,A1 ,5HMM!  , F5 , 0, 5X, F4 , 0, 3X, F7 . 0 ) 
F0RMAT<45X,35HSLANT  RANGE  OBS-TGT  -  KM 
F0RMAT<45Xj35HELEVATI0H  OF  TARGET  -  DEG 
F0RMAT<45X,35HAZIMUTH  OF  TARGET  -  DEG 

F0RnAT<45X.35HC0RRECTED  FOR  VISIBILITY 
F0RMAT<45X,35HMARITIME  ARCTIC  AIR  MASS 
F0RMAT<45X,35HMARITIME  POLAR  AIR  MASS 
F0RMAT<45X.35HC0NTINENTAL  POLAR  AIR  MASS  - 
F0RMAT<45X,35HC0RRECTED  FOR  RAIN 
F0RriAT<45X,35HC0RRECTED  FOR  SHOW 
F0RMAT< 1H0.44X,35HMETEOROLOGICAL  INPUTS 
FORMAT< 1H0,44X,35HINPUTS  FOR  PASQUILL  CATEGORY 


TOTAL 


=,F7.3) 
=,F7 .2) 
=,F7.2) 
,4X,2A2) 
,4X,2A2.) 
,4X,2A2) 
,4X,2A2) 
,4X,2A2) 
,4X,2A2> 
) 

) 


SMOKE) 


FORMAT< 1HO,44X,42HTRANSMISSION  THRESHOLDS 
FORMAT<  45X, 4A2. 1 8X, F5 . 3, 6X, F5 . 3 ) 

FORriAT<33X,  12<  1H-),44X,  12<  1H-)/33X,  1H-,  1X,4A2,  IX.  1H-.44X.  1H-.  IX; 
4A2, IX. 1H-/33X. 12< 1H-),44X. 12< 1H->) 

FORMAT<  tX.2<34X.6Hi.ENGTH.8X.8HDURATION)/1X.2<34X.6HMETERS.9X. 
7HMINUTES)) 

FORMAT< IX, 2< 1 9X , 6HSCREEN , 8X, F7 . 0, 9X , F7 . 2 ) > 

F0RMAT<32X.A2, 13H  SMOKE  SCREEN. 41 X. A2, 1 3H  SMOKE  SCREEN/32X. 

15< 1H-), 41X, 15< 1H- )) 

F0RMAT<32X, A2, A1 , 1 1HMM  HOWITZER, 42X, A2, A1 , 1 1 HMM  HOWITZER) 

FORMAT< 1X,2< 19X,6HV0LLEY,6X,25HGUNS  RATE  SPACING  ROUNDS)) 
FORMAT<  37X , 4H/MIN , 3X , 6HMETERS , 43X, 4H/MIN , 3X, 6HMETERS  ) 

FORMAT<20X, 1 IHINITIAL!  , F5 . 0, 6X, F8 , 0. 26X, 1 1 HINITI AL ! 

F5, 0,6X,F8. 0) 

FORMAT< 1X,2< 19X, 1 1HSUSTAINING i , F5 , 0, F5 . 1 . F9 . 0 , F7 , 0  )  ) 

END 


CWC0421 0 
CWC04220 
CUC04230 
CWC04240 
CWC04250 
CWC04260 
CUC04270 
CWC04280 
CWC04290 
CWC04300 
CWC0431 0 
CWC04320 
CWC04330 
CWC04340 
CWC04350 
CWC 04360 
CWC04370 
CWC04380 
cue 04390 
CWC04400 
CWC0441 0 
CUC04420 
CWC04430 
CWC04440 
CUC04450 
CWC04460 
CWC04470 
CWC04480 
CWC04490 
ewe  04500 
ewe  0451  0 
CWC04520 
CWC04530 
CWC04540 
CWC04550 
ewe  0456  0 
CWC04570 
ewe 04580 
CWC04590 
CWC04600 
CWC0461 0 
CWC04620 
CWC04630 
CWC04640 
ewe 04650 
eweo466o 
eWC04670 
eWC04680 
ewe 04690 
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SUBROUTINE  CUIC1  <  IPO ,  CO ,  C 1  ,  SL«^T ,  3L0NG,  3  JOATE,  SZHuUft  ,  S 0  > 

CUX0001 0 

DIMENSION  ITAB<7,9> 

CWX00020 

COMMON  /CONST/  PI , P 1 2 , P 1  RAD , TUOP I , TORRMB , CDEGK 

CWX00030 

DATA  ITAB  / 

CWX00040 

1  1,1, 2, 3, 4,6,6, 

CUXOOOSii 

2  1 ,2, 2, 3, 4, 6, 6, 

CWX00060 

3  1 ,2, 3, 4, 4, 5, 6, 

CWX00070 

4  2, 2, 3, 4, 4, 5, 6, 

CWX00080 

5  2, 2, 3, 4, 4, 4, 5, 

CWX00090 

6  2, 3, 3, 4, 4, 4, 5, 

CWX001 00 

7  3, 3, 4, 4, 4, 4, 5, 

CUX001 1 0 

8  3, 3, 4, 4, 4, 4, 4, 

CUX00120 

9  3, 4, 4, 4, 4, 4, 4/ 

CWX00130 

ASIN<ARG  >  =  ATAN2<  ARC,  SQRTC  1  .-ARG*>»2>) 

C^*METEOROLO&ICAL  CALCULATIONS, 

CWX001 40 

C 

CWX00150 

IFtCI  .NE.  100. >  GO  TO  1000 

CUXuOl 60 

IF<C0  .GT.  21 33. 6042 >  GO  TO  1000 

CUXOO 1 70 

11=0 

CWXOOi SO 

12=0 

CWXOOl 90 

GO  TO  2300 

CUiX0020u 

1000  CONTINUE 

CWX0021 0 

C  CALCULATE  ANGULAR  FRACTION  OF  A  VEAR  FOR  A  GIVEN  JULIAN  DATE. 

CUIX  0  022  0 

R9=PIRAD 

CliiX00230 

D9=1 . /R9 

CuX0024u 

SLAT1=SLAT*R9 

CUIX  0  025  0 

A0=< ( S JDATE-1 . )*360, >/365 . 242 

CulX0026u 

C  CALCULATE  SOLAR  DECLINATION  ANGLE  <A4). 

CWX0u2?  0 

Ai  =A0'»R9 

CUiX0u2Su 

A2»279.9348+A0 

CUIX00290 

A2=A2*< 1 . 91 4S27*SIH<  A1  )  )-<  0 . OZSSZS^COSt A1 >  > 

CUIX0u3uC 

A2=A2+<  0. 019938*SIN<2*A1  >>-<  0,  00162*COS<2'*A1  >) 

CWX0031 0 

A2=A2fR9 

CUIX00320 

A3«=23.4438*R9 

CUIX00330 

A4=SIN<A3>*SIN< A2) 

ClilX00340 

A4=ASIN< A4  ) 

CUIX  00350 

C  CALCULATE  THE  TIME  OF  MERIDIAN  PASSAGE  -  TRUE  SOLAR  NOON  < A5 > . 

CUIX00360 

A5=  12,+<  0. 12357*SIN< A1 ) >-<  0 . 004289*COS< A 1 >> 

CUIX00370 

A5=Afi+<  0.  153809*8IN<2»A1  >)+<  0.  060783*COS<  2^A1  >> 

CHX 00380 

C  CALCULATE  SOLAR  HOUR  ANGLE  < A6  )♦*»  NOTE  THIS  VERSION  USES  +  SIGN 

CUIX00390 

C  ON  SLONG  DUE  TO  EAST-LONGITUDE  POSITIVE  CONVENTION. 

CUIX  004  0  0 

A6= i 5 ■ *<  S2H0UR-A5  >+SLOHG 

CWXO'.  41  0 

A6=A6h>R9 

CUIX00420 

C  CALCULATE  SOLAR  ALTITUDE  <A7). 

CUIX00430 

A7=SIN<SLAT1  >*SIN< A4 >+COS< SLAT1 >*C03< A4 >»C03( A6 > 

CUIX00440 

A7  =  ASIN<  A7  ) 

CWXO 04 50 

1100  CONTINUE 

CUIX  00460 

A7=A7'»D9 

CWXO 0470 

C  CALCULATE  INSOLATION  CLASS  NUMBER. 

CUIX00480 

12=0 

CWXO 0490 

IF< A?  .LE.  60. >  GO  TO  1200 

CWX00500 

12=4 

CWXO 051 0 

GO  TO  1500 

CWX00520 

1200  CONTINUE 

CWX00530 

IF< A7  .LE,  35. )  GO  TO  1300 

CWX00540 

12=3 

CWXO 0550 

GO  TO  1500 

CUXOuSfcO 

1300  CONTINUE 

CWXO 05 70 

IF<:  A7  .LE.  15.  )  GO  TO  1400 

CWX00580 

12=2 

CWXO 0590 

GO  TO  1500 

CUX00600 

1400  CONTINUE 

CWXO 061 0 

, 

IF<A7  .LE,  0. )  GO  TO  2200 

CWX00620 

12=1 

CWX00630 

C  CALCULATE  NET  RADIATION  INDEX  FOR  DAVTIME. 

CWX00640 

1500  CONTINUE 

CWX00650 

13=0 

CWX00660 

IF<C1  ,GT.  50. )  GO  TO  1600 

CWX00670 

13=12 

CWXOObdO 

GO  TO  1900 

CWX00690 

r 
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CONTINUE 

CUX00700 

IF<C0  .GT. 

2133.6042)  GO  TO  1700 

CWX0071 0 

13=12-2 

CiJX0072u 

GO  TO  1900 

CWX00730 

1700 

CONTINUE 

CWX0u740 

IF(.C0  .GE. 

4876.8096)  GO  TO  1800 

CWX00750 

13=12-1 

CUX00760 

GO  TO  1900 

CWX00770 

1800 

CONTINUE 

CWX 00780 

IFCCI  .NE. 

100.)  GO  TO  1900 

CWX0C790 

13=12-1 

CWXOOdOO 

1900 

CONTINUE 

CUX0081 0 

IFiiS  .NE. 

0)  GO  TO  2000 

CUX00820 

13=12 

CUXC0830 

20  00 

CONTINUE 

CUIXu0840 

IF< 13  . G 1 . 

i  )  GO  TO  2100 

CWX 00850 

1 3=  1 

CWX 00660 

21  00 

CONTINUE 

CWX00870 

1 1  =I  J 

CUX00880 

GO  TO  2300 

CWX00890 

C  COMPUTE  NET  RhDIATION  INDEX  FOR  NIGHTTIME. 

CWX00900 

2200 

CONTINUE 

CUX0091 0 

IFtCi  .GT. 

40. >  GO  TO  2250 

CWX 00920 

I1=-2 

CWX 00930 

GO  TO  2300 

CWX00940 

2250 

CONTINUE 

CWX00950 

Il=-1 

CWX00960 

C  CALCULATE  PASOUILL  STABILITY  CATAGORV. 

CWX00970 

2300 

CONTINUE 

CWX009S0 

14=0 

CWX00990 

15=0 

CWX01 000 

IF<I1  .NE. 

4)  GO  TO  2400 

CWX01 01 0 

14=1 

CWX01 020 

2400 

CONTINUE 

CWX01 030 

IFdl  .NE. 

3)  GO  TO  2420 

CWX01 040 

14=2 

CWXOl 050 

2420 

CONTINUE 

CWX01 060 

IF<I1  .HE. 

2  )  GO  TO  2440 

CWXOl 070 

14=3 

CWXOl 080 

2440 

CONTINUE 

CWXOl 090 

IF<I1  .NE. 

1  )  GO  TO  2460 

CWXOl 1 00 

14=4 

CWXOl 1 1 0 

2460 

CONTINUE 

CWXOl 120 

IF<I1  .NE. 

0)  GO  TO  2480 

CWXOl 130 

14=5 

CWXOl 140 

2430 

CONTINUE 

CWXOl ISO 

IF<I1  .NE. 

-1  )  GO  TO  2500 

CWXOl 160 

14=6 

CWXOl 170 

2500 

CONTINUE 

CWXOl 180 

IF<I1  .NE. 

-2)  GO  TO  2520 

CWXOl 190 

14=7 

CWX01200 

2520 

CONTINUE 

CWX0121 0 

IFCSO  .GE. 

2.  )  GO  TO  2540 

CWX01220 

15=1 

CWX01230 

GO  TO  2700 

CWX01240 

2540 

CONTINUE 

CWXOl 250 

IF<S0  .GE. 

4.  )  GO  TO  2560 

CWX01260 

15=2 

CWX01270 

GO  TO  2700 

CUX01280 

2560 

CONTINUE 

CUX01290 

IF<S0  .GE. 

6.  )  GO  TO  2580 

CWX01300 

15=3 

CWX0131 0 

GO  TO  2700 

CUX01320 

2580 

CONTINUE 

CUX01330 

IF<S0  .GE. 

7.  )  GO  TO  2600 

CWX0t340 

15-4 

CWX01350 

CO  TO  2700 

CUX01360 

2600 

CONTINUE 

CWX01370 

IF<S0  .GE. 

8.  )  GO  TO  2620 

CWX01380 

15=5 

CWX01390 

GO  TO  2700 

CUX01400 

2620 

CONTINUE 

CUX01 41 0 

IF<S0  .GE,  10.) 

GO 

TO 

2640 

CUX01420 

15-6 

CUX01430 

GO  TO  2700 

CUX01440 

2640 

CONTINUE 

CUIX01450 

IFCSO  .GE.  11.; 
15=7 

GO  TO  2700 

GO 

TO 

2660 

CiilXOI  460 
CWX01470 
CUIX01480 

266  0 

CONTINUE 

CWX01490 

IFc  SO  . GE .  12.; 

GO 

TO 

2630 

CUIX01500 

1 5 =.9 

CUIX  0151  0 

GO  TO  2700 

CUXOI 520 

2680 

CONTINUE 

CUIX01530 

15=9 

CuIXOI  540 

27  00 

CONTINUE 

CUXOI 550 

IP0=ITAB< 14, I5> 

CUXOI 560 

RETURN 

CWX01570 

END 

CUXOI 08 0 
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SUBROUTINE  CUIC3  < ARE, DLS, C2, 00, D2, H, IPO.RO, R2. U  V,V1> 

01  HENS  I  ON  A<6>iS<6,3>,D<6,3),Ht2,2>,U<2,2>,V<2> 

COMMON ^ /CONST/  P 1 , P 1 2 , P I RRO , TWOP I , TORRMB , COEGk 
OATP  P/0.4, 0.32,0.22,0.144,0.102,0. 076/ 

c  / 

* . 139085297, . 122097643, .1101 04377, . 097649832, . 070772166, . 055437093 
• . 013017284, . 01 0970370, . 01 0962963, . 01 04 1 851 9, 7 . 27284E-3 , 6 . 553 09E-3 
X.-1 . 02581E-4,-6.80135E-5,-6.73401E-5,-6.83502E-5,-4.500S6E-5, 

*-4. 01796E-5/ 

DATA  D  / 

*.944814815, ,894803591 , .854792368, .816026936, . 786026936, .72601 571 3 
*-4.85185E-^,-4.e3951E-3,-4.82716E-3,-6.07407E-3,-6. 07407E-3, 

*3?7037E-i,3.59M7E-5,3.47924E-5,4.7138E-5,4.7138E-5,4.60157E-5/ 
DATA  W/0. 016, 0.016, 0.016, 0.016, 0.016, 0.016/ 

C*ATMOSPHERIC  DIFFUSION  CALCULATIONS. 

Al=-1  .24+1  .  19*AL0G1 0<ARE) 

Z1=iO.**A1 

A2=AeS<  DLS-DO  >*<  Pl/1  80  .  v  ■ 

R2=SwRT<  1  3 . 69/<  1  3 . 69*SIN<  AiJ  )*SIN<  >+COSt  A2  >*Cqs<  »2  f  > 
yi  =  1  . 09521547+<  0. 02906894*R0 >-< 4 . 9575E-04«R0*R0 )+ 

2  <4.82E-06*R0*Rfl*Ru) 

Y2=3 . 3640591 44+<  0 . 060502571*R0  >-< 1 . 15301E-03*R0*R0  >+ 

2  <•  1 . 33942E-05*Ro*R0*R0  > 

C2=S< IPO, 1 >+S< 1P0,2>*Z1+S< IP0,3>*Z1**2 
D1=D< IPO, 1 )+D< IP0,2)*Z1+D< IP0,3)*Z1**2 
02=1/01 
DO  5400  1*1,4 

C+CAUCULATE  CROSSUIND  INTEGRATED  CONCENTRATION  FOR  WP  SMOKE. 

DO  5300  K*1 ,2 

IF  <I  ,LT,  3  .AND,  IPO  , GT .  4>  GOTO  5300 
S1=U<K, 1  )+0,74*A< IP0>*1 00.**0 .9 
S2*U<K,2)+0.667*C2*1 00. ♦*01 
V<  K  )=<  U<  1 P 0  )*Y2*H<  K ,  2  >  )/<  P  I*S  1  >*S2  > 

5300  CONTINUE 
5400  CONTINUE 
RETURN 
END 


CUY0001 0 
CUY00020 
CUY00030 
CUV 00 040 
CUY00050 
CWY00060 
,  CUV 00070 
,CWY00080 
CWY00090 
CUY001 00 
CUY001  1  0 
,CWV00120 
CUY00130 
CWY00140 
CWV00150 
cwyooi6o 

CUY00170 
CUY00180 
CWY00190 
CWVC0200 
CWV002i 0 
CUY00220 
CiiiV0023u 
CWY 00240 
CiiiV  0  0250 
CUV00260 
CWV00270 
CUY00280 
CWY 00290 
CUY00300 
CUY0031 0 
CWY00320 
CWV00330 
CWV00340 
CUY00350 
CWY 00360 
CWY 00370 
CWy00380 
CWY00390 
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SUBROUTINE  CWIC4  < C, C2, D2, H, P, Q t , 02, ft , R2, S3, TIME, V, XO , V , VI , Z, IPO >  CUZOOOIO 
REAL  I1E<2>  CUZ00020 

DIMENSION  C<4,2i,H<2,2i,P<4,2,2>,Q1<4,2,2>,Q2<4,2,2>,R<  4,2>,  V<2>,  CWZODOSO 
•*Y<4,2,2),Z<4,2,2) 

DPTA  ME/0.4,0.4<^  CU200050 

C>*MIJNITI0NS  EXPENDITURES,  CW200060 

DO  6900  I>=1,4  CU200u70 

C*  CALCULPTE  INITIAL  SHELL  SPACING  POR  HC  SMOKE  CU200080 

DO  6800  K=1,2  CWZOOOyu 

IF<I  ,GT.  2>  GO  TO  6100  CWZOOlpO 

Y< I, 1 ,K>=45.*S3  lWZOOIIu 

C*  CALCULATE  SUSTAINING  SHELL  SPACING  FOR  HC  SMOKE  CW200120 

IF<C<I,1)  .NE.  0.;  GO  TO  5500  UUZOulSu 

Y<I,2,K>=0.  CW200140 

GO  to  5600  CW200150 

5500  CONTINUE  CWZ00160 

Y<  I,2,K)=l/^ft2*<<  0.731*ME<k>fYl'*H<K,1  >  >/<  CZ-fSSH.CC  I,  1  )>)'»-*D2  J,ul20ul7u 

IF<Y<I,2,K1  .GT.  XO)  Y<I,2,K)=X0 

5600  CONTINUE  CUZppISO 

IF<y<I,2,K>  .NE.  0.)  GO  TO  5700  CW^Up^OO 

QKI,2,K)=1.  CW20p22p 

GO  TO  5900  9U10023p 

5700  CONTINUE  Q!J?oy24g 

C*  CALCULATE  INITIAL  VOLLEY  FOR  HC  SMOKE  CWiuUiiSu 

IF<y<I,l,K)  .GT.  Y<I,2,K:)>  Y<I,1,K>=Y<I,2,K>  Ck20p260 

QK  I,  1  ,K)=X0ZY<  I,  1  ,K)  ClJ20027p 

Q5=AINT<Q1< I, 1 ,K)) 

Q6-Q1< I, 1 ,K  )-05  CU2pp29p 

1F<Q6  .EG,  0.)  GO  TO  5800  CW20g3p0 

01<I,1,K)=:Q5+1  .  CWZUUJIU 

5800  CONTINUE  CW200320 

C*  CALCULATE  NUMBER  OF  GUNS  FOR  SUSTAINING  VOLLEYS  <HC>  CW2pp33p 

Gii<  i,2,K>-xo/'y<  I.2.K) 

Q5=AINT<Q1< I,2,K))  00200350 

Q6»G1< I,2,K)-Q5 

IF<Q6  .EG.  0.>  GO  TO  5900  SHISSiH 

Q1<I,2,K>-Q5+1 .  CW2pp3|p 

5900  CONTINUE 

C*  CALCULATE  RATE  OF  FIRE  FOR  HC  SMOKE  cW2004pg 

RU,1>«0.5  i;U.i004to 

IF<C<I,1)  .NE,  0.)  GO  TO  6000 

R<I,t)=0.  CW20043CI 

6000  CONTINUE  CU200440 

C*  CALCULATE  TOTAL  NUMBER  OF  ROUNDS  REQUIRED  < HC  SMOKE)  CU20045p 

P<I,K,1  )«Ql<I,l,K»<0.5*Q1<I,2,K>f<  TIME-2.  )> 

Q5=AINT<P< I,K, 1 )> 

Q6=P< I,K, 1 )-Q5  CW|pp4|p 

IF<Q6  .EG.  0.)  GO  TO  6100 

P< I,K,1 >=Q5+1 .  CWZOpSpp 

6100  CONTINUE 

IF< I  .LT.  3  .AND,  IPO  .GT.4>  GO  TO  6775  uWZpOSZO 

C*  SHELL  SPACING  < Z<  >)  AND  VOLLEYS  <fii<  >>  -  WP  SMOKE  CW^ppSjy 

IF<C<I,2)  .NE.  0.)  GO  TO  6200 
2<I,1,K)=0. 

Z<I,2,K)=0,  CW200560 

Q2<i7  ;K)-6.  CWZ00570 

Q2<I  2  K)*0.  CW200580 

GO  TO  6400  CW200590 

6200  CONTINUE  gS|9060g 

IF< I  .LT.  3)  GO  TO  6250  CW2o061o 

IF  <I  ,GT.  2)  Q2<I,1,K)-0,6*C<I,2)/'V<K>  CW2p062p 

GO  TO  6300 
6250  CONTINUE 

2<  1 ,  1  ,K>-V<K)/’C<  I,2)*1  00.  PHISSff  2 

2<  I,2,K>-2<  I,  1  ,K>  PHISSfIS 

Q2<  1,  1  ,K>»X0/2<  I,2,K>-H  . 

6300  CONTINUE 

Q5-AINT<Q2< I, 1  ,K))  CU2pp690 

Q6«Q2< I , 1 ,K>-Q5  CW200700 
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IF  <06  .E£).  0.  >  GO  TO  6350 
Q2<I,1,K>*Q5+1 . 

6350  CONTINUE 

Q2<  I,2,K>=Q2<  I,  1  ,K> 

6400  CONTINUE 

C"*-  RATE  OF  FIRE  FOR  WP  6M0KE 

IF<C<I,2'}  .HE.  O.i  GO  TO  6425 
R<  I,2)=0. 

GO  TO  6600 
6425  CONTINUE 

IF  < I  .CT.  2)  GOTO  6450 
R<  I,2>=<2<  I,2,K>+60.  )/S3 
GO  TO  6475 
6450  CONTINUE 

K<  1 , 2  >=1  20  .  /“SB 
6475  CONTINUE 

R<  I,2>»R<  I,2)/'20. 

R5=AINT<R< 1,2)) 

R6=R< I ,2)-R5 

IF<R6  .LT.  0,5)  GO  TO  6500 
R5=R5+1 . 

6500  CONTINUE 

IF(R5  .NE.  0. )  GO  TO  6550 
R5=1  . 

6550  CONTINUE 

R<  I,2)=R5f20.,^60. 

6600  CONTINUE 

C*  CALCULATE  TOTAL  NUMBER  OF  ROUNDS  REQUIRED  <WP> 

IF<C<I,2)  .NE.  0.)  GO  TO  6650 
P<  I,K,2)«0. 

GO  TO  6700 
6650  CONTINUE 

IF<I  ,GT.  2)  GO  TO  6700 

P<  1,K,2)=Q2<  I,2,K)>t«<  1  .<"R<  I,2))*<TIME-R<  I,2>) 

CO  TO  6750 
6700  CONTINUE 

P<  I,K,2)»Q2<  1, 1  ,K)i'<X0/60.+1  ,  )■«.<  1  . /R<  1 , 2  >  >♦<  TIME-R<  1 , 2  >  ) 
6750  CONTINUE 

Q5=AINT<P< I,K,2>> 

Q6=P< I,K,2)-Q5 

IF<Q6  .EQ.  0. )  GO  TO  6800 

P<  I,K,2)=>Q5+1  , 

GO  TO  6800 
6775  CONTINUE 

C*  CALCULATIONS  FOR  E  AMD  F  STABILIY  CAT  < STABLE  FLOW) 

C*  INITIAL  SHELL  SPACING  FOR  WP  SMOKE 

IF<I  .EQ.  1  .AND.  K  . EQ .  1 )  2< I , t , K  )>1 00 . 

IF<I  .EQ.  2  .AND.  K  . EQ .  1)  2<I,1,K)«50. 

IF<I  ,LT.  3  .AND.  K  . EQ .  2)  Z< 1 , 1 , K >-1 00 . 

C«  SUSTAINING  SHELL  SPACING  FOR  WP  SMOKE 

IF<I  .EQ.  1  .AND.  K  .EQ.  1)  Z< I , 2, K >=1 00 . 

IF< I  .EQ.  1  .AND.  K  .EQ.  2)  Z< I ,2,K)a200. 


IF< I  .EQ.  1  .AND.  K  .EQ.  2)  Z< I ,2,K)a200. 

IF<I  .EQ.  2  .AND.  K  .EQ.  1)  Z<  1 , 2,K  )>‘50 . 

IF<I  .EQ.  2  .AND.  K  . EQ .  2)  Z< 1 , 2 , K  )«1 00 . 

C>*  INITIAL  VOLLEY  FOR  WP  SMOKE 

Q2<  I,  1  ,K)=X0/'2<  I,  1  ,K)+1  . 

C>»  SUSTAINING  VOLLEY  FOR  WP  SMOKE 
Q2<1,2,K)>X0/Z<1,2,K)-M  . 

C«  RATE  OF  FIRE  FOR  WP  SMOKE 
IF<K  .EQ.  1 )  R< I,2)-.5 
IF<K  .EQ.  2)  R< I,2>»1 . 

C*  TOTAL  NUMBER  OF  ROUNDS  REQUIRED  < WP ) 

P<  I,K,2)=Q2<  1, 1  ,K)+Q2<  I,2,K)i.1  . /'R<  1 , 2  )♦<  TIME-R<  1 , 2  )  > 
6800  CONTINUE 

R<  I,2)-l  ./'R<  1,2) 

6S00  CONTINUE 
RETURN 
END 
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CWZ 00830 
CWZ00840 
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CWZ00860 
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CWZOOSI 0 
CW200S20 
CW200S30 
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CWZ01 000 
CWZ01 01 0 
CWZ01020 
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000000000000000000000000000000000000000000000000000000000000000000000 


SUBROUTINE  ITAH< lERR . TFNL > 

THIS  ROUTINE  IS  ftN  INVERSION  OF  THE  NVS.EOL  TARGET  hCOUISITION 
MODEL,  WITH  EMPHASIS  ON  THE  DEGRADATION  < TRANSM I TTANCE  ) 
REQUIRED  TO  PREVENT  DETECTION  ABOVE  A  GIVEN  PROBABILITY, 


INPUTS  ARE  ON  STANDARDIZED  RECORDS: 

KEY  WORD  -  COLUMNS  t-4,  FROM  AMONG  TARV , SENS , GO , PAGE  AND  DONE. 
DATA  FIELDS,  ALL  REAL  -  COLS  11-20,  21-30,  31 -40,  .  .  .  ,  71 -80 . 

INPUT  CAROS  ARE  ORDER  INDEPENDENT,  UlTH  ARBITRARY  OR  SYSTEM 
DEFAULTS  CHOSEN  IF  CARDS  ARE  LEFT  OUT,  OR  IF  VALUES  ARE  INPUT  0, 
THE  EXCEPTION  TO  ORDER  INDEPENDENCE  IS  THAT  AFTER  EACH  SET  OF 
INPUTS  A  <G0>  CARD  MUST  BE  PLACED  TO  INITIATE  EXECUTION  OF 
ONE  LOOP  THROUGH  THE  PROGRAM,  FOLLOWING,  OR  IN  PLACE  OF 
THE  LAST  INPUT-SET  GO  CARD,  A  < DONE >  CARD  MUST  BE  PROVIDED  TO 
CAUSE  CONTROL  TO  EXIT  ITAM  AND  RETURN  TO  THE  SCREEN  EXEC  MODULE. 

IN  SUBSEQUENT  RUNS  < DELINEATED  BY  GO  CARDS >  TABLES  MAY  BE 
PRODUCED  LINE-BY-LINE,  AND  ANY  INPUT  WHICH  HAS  NOT 
BEEN  CHANGED  < IE  INPUT  AS  0.)  WILL  USE  THE  VALUE  GIVEN  ON  THE 
PREVIOUS  RUN.  EXCEPTIONS  ARE  THE  FOV  AND  AMAG  VALUES  WHICH  MUST 
BE  SPECIFIED  WHENEVER  A  NEW  DEVICE  NUMBER  nLSO  IS  INPUT,  OR 
THESE  VALUES  ASSUME  DEFAULTS  FOR  THE  DEVICE. 


KEY  WORD 

COLS. 

VARIABLE 

DESCRIPTION 

TARV 

1  -4 

TARGET/'SCENARIO  DESCRIPTION 

11-20 

ACON 

INTRINSIC  CONTRAST  < DIMENSION¬ 
LESS  >  OR  TEMPERATURE  DIFFERENCE 
OF  TARGST.'^BACKGROUND  <DEG  k) 

FOR  THERMAL  DEVICES. 

-  SKV/GROUMD  RATIO.  < DIMENSION¬ 
LESS),  USED  FOR  NON-THERMAL 
DEVICES.  SOG  SHOULD  INCLUDE 

A  FACTOR  FOR  CLOUD  REFLECTANCE 

21-30 

SOG 

31-40 

R 

RANGE  TO  TARGET  <k'M) 

41-50 

TARS2 

-  TARGET  MINIMUM  DIMENSION  <M>. 

51-60 

ZONE 

SEARCH  ZONE  <DEG,i‘'*'2> 

61-70 

ALFLG 

-  AMBIENT  ILLUM,  CATEGORY  < SEE 

LIST  BELOW)  CONVERTED  TO  HAL, 

AN  INTEGER,  IN  PROGRAM.  USED 

FOP  NON-THERMAL  DEVICES. 

71-80 

ALIGHT 

-  IF  ALFLG-0.,  THE  USER  MUST 

PROVIDE  AN  AMBIENT  ILLUM,  HERE 
<FT,  CDL3.  ) 

SENS 

1-4 

SENSOR  DESCRIPTION 

1 1-20 

PS 

-  INPUT  PROBABILITY  OF  DETECTION. 

< DIMENSIONLESS  > 

21-30 

DVNUM 

-  DEVICE  NUMBER.  CONVERTED  TO  LSC, 
AN  INTEGER,  IN  PROGRAM, 

31-40 

DMODE 

-  OPERATIONAL  MODE  <1.  =  WIDE  FOV, 
2.  =  NARROW  FOV).  CONVERTED  TO 
MODE,  AN  INTEGER,  IN  PROGRAM. 

41-50 

FOV 

-  FIELD  OF  VIEW  C DEG .  ) 

51-60 

AMAG 

-  MAGNIFICATION  < FOR  VISIBLE  ONLY) 

61-70 

AOOB 

-  LEVEL  OF  ACQUISITION  < MEDIAN 
RESOLVABLE  NORMALIZED  CYCLES, 
USUALLY  1.  FOR  DETECTION) 

PAGE 

1-4 

<OPTIOMAL>  -  FORCE  PAGE  EJECT, 

WRITE  HEW  HEADER.  < USEFUL  FOR  TABLE 
GENERATION. ) 

CO 

1-4 

EXECUTE  ONE  LOOP  WITH  GIVEN  INPUTS 

DONE 

1-4 

END  COMPUTATIONS  AND  EXIT  THE  ITAM 

I T  A  0  0  0  (  0 
ITA00020 
ITA00030 
I TA 00040 
ITA00050 
ITAOOOSO 
ITAOU070 
ITA00080 
ITA00090 
ITA001 00 
ITA001 1 0 
ITA00120 
ITA00)30 
ITAOOMO 
ITA00150 
ITAOOIbO 
ITAOul 70 
1TA00180 
1TA00190 
I TA 002 00 
ITA002i 0 
1TA00220 
ITA00230 
ITA00240 
1  TAG  023  0 
ITA00260 
I TA 00270 
ITA00280 
I  TAG  0290 
1TA00300 
I T  A  0  03 1  0 
TTA00320 
ITA00330 
ITA00340 
ITA00350 
ITA00360 
ITA00370 
ITA003S0 
ITA 00390 
I TA 004 00 
ITA004i 0 
ITA00420 
ITA00430 
ITA00440 
ITA00450 
ITA00460 
1TA00470 
ITA00480 
ITA00490 
ITA00500 
ITA0051 0 
ITA00520 
ITA00530 
ITA00540 
1TA00550 
ITA00560 
ITA00570 
ITA 00580 
1TA00590 
ITA00600 
ITAOOSf  0 
1TA00620 
ITAu063u 
ITA00640 
ITA00650 
1TA00660 
ITA00670 
ITA00680 
ITA00690 
ITA00700 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


OUTPUTS-.  TFNL, 


ROUTINE.  tMAV  BE  USED  IN  PLACE  OFITA00710 
OR  FOLLOWING  THE  LAST  GO  CARD!)  ITA00720 

ITA00730 

THE  TOTAL  PATH  TRANSMITTANCE  < DIMENSIONLESS >  ITA00740 

REQUIRED  TO  KEEP  THE  PROBABILITY  OF  DETECTION  LESS1TA00750 
THAN  OR  EQUAL  TO  THAT  INPUT,  AS  COMPUTED  FROM  THE  ITA00760 
FINAL  SET  OF  INPUTS  PRECEDING  THE  DONE  CARD. 


PRINT 


OUTPUTS: 

C 

RC 


ALL  INPUT  PARAMETERS  AND 

CONTRAST  OR  TEMPERATURE  DIFFERENCE  AT  DEVICE 
REQUIRED  FOR  GIVEN  LEVEL  OF  DETECTION  PROBABILITY 
RESOLVABLE  CYCLES  REQUIRED  AT  TARGET  FOR  GIVEN 
PROBABILITY  OF  DETECTION. 

TOTAL  PATH  TRANSMITTANCE  TO  REDUCE  ACON  AT  TARGET 
TO  C  AT  DEVICE, 

SUBROUTINES:  ITAM  CALLED  BY  SCREEN.  ITAM  CALLS  CYCLE,  CINV,  TREQ , 


TTOT 


AMBIENT  ILLUMINATION  CATEGORIES: 


ALFLG  OR  NAL 

0 

1 

2 

3 

4 

5 

6 

7 

8 
9 


FT.  CDLS. 

usiR"ipicT 

1  GO. 

10. 

1  . 

0,1 
0.01 
0.001 


0001 

00001 

000001 


APPROX.  CONDITIONS 


CLEAR  TO  SLIGHT  OVERCAST 
HEAVILY  OVERCAST  DAY 
SUNSET 

1X4  HR.  AFTER  SUNSET 
1X2  HR.  AFTER  SUNSET 
MOONLIT,  CLEAR 
MOONLIT,  OVERCAST 
STARLIGHT  ONLY 
MINIMAL  STARLIGHT 


DIMENSION  RV<7),  IT<2),AMAGW<  14),AI1AGN<  1 4  ),  FOVW<  1 4  ),  F0VN<  14), 
♦  ALFACS),  IR<  1  0),BETA<9),GAMA<9>,AMRAL<6,3>,AMRGMC6,3) 


ITA00770 
ITA00780 
ITA00790 
ITA00800 
I TA 0081 0 
ITA00820 
ITA00S30 
ITA00840 
ITA00850 
ITA00860 
ITA00870 
ITA00880 
ITA00890 
ITAOOSOO 
IT  AO 091 0 
ITA00920 
ITA00930 
ITA00S40 
ITA00950 
I TA 00960 
ITA00970 
ITA00980 
ITA00990 
ITA01 000 
ITA01 01 0 
ITACl 020 
ITA01 030 
ITA01 040 
ITA01 050 
ITA01 060 


COMMON  XIOUNITXIOIN, lOOUT, IPHFUN,LOUNIT,HDIRTU,NCLIMT,KSTOR,NPLOTUITA01 070 
COMMON  XGEOMETXPTS< IS), IGEOSW  ITA01080 

DATA  IRX2HD0,2HNE,2HG0,2H  , 2HTA, 2HRV, 2HSE, 2HNS, 2HPA , 2HGEX  ITA01 090 

DATA  AMAGW  XI  .  0, 7 . 0 ,  1  R-t-O  .  X ,  ITA01100 

*  AMAGN  XI . 0,7. 0, 12*0.X,  ITA01110 

*  FOVW  X24, S, 8. 0, 15. 0,9. 0,6. 0,4,67,4.67, 1 0.62,9.24,8. 0,4*0. X,  ITA01120 

*  FOVN  X24. 5,8. 0,3*0. , 1 .56, 0. ,3,54,2.31 , 1 . 0,4*0. X  ITA01130 

DATA  TGT,SGR,FV,RN,ALV,OMG, AJB,PD,DVN,DMD, ACN  X2.3,  ITA01140 

*  3. ,7. , 1 . , 1 . , 1 . , 1 . , . 1 ,2. , 1 . , 1 .X  ITA01150 

DATA  ALFA  X 1 . 089005 ,. 009730 , 1 . 8528, -0 . 00 02 1 97 ,. 1 39 , 0 ., 0 ., 0 ., 0 . X  ITA01I60 
DATA  BETAX-1 .801654, . 03536,-3. 13169, . 051 4, 0 . , . 0651 ,.1124,. 0968,  ITA01 170 

*.12X  ITA01180 

DATA  GAMAX4. 21 7775, 2. 3575, 5. 17227,2.32178,2.7933, 1.6149,1 .3364,  ITA01 190 

*. 56867,. 29X  ITA01200 

DATA  AMRALX. 05850156, .1022697, .2444688, .7264854,3.736508,  ITA01210 

*-16.87941,  .06709132, .1137755, .3177794, .7642010,6.549327,  ITA01220 

*-16,18440,  . 04109820, . 0715830, .1524969, .2319469, 1 .494814,  ITA01230 

*5.731956X  ITA01240 

DATA  AMRGMX2.94273,2.43789,2. 11113,2,05233,3.33957,-4.98529,  ITA01250 

*  5.22111,4.28211,4.13668,3.44685,9.16003,-7.70891,  ITA01260 

*  2.80725,2.70329,2.48447, 1 .63044,2.73650,3.47838  X  ITA01270 

.*4.414.*  INITIALIZE  VALUES  <FIRST  EXECUTION)  ITA0I280 

PB-,632  ITA01290 

ACON-0.  ITA01300 

SOG-0.  ITA01310 

RNC-0.  ITA01320 

TARS2«0.  ITA01330 

UZONE-0.  ITA01340 

ALFLG-0.  ITA01350 

ALIGHT-0.  ITA01360 

PDET-0.  ITA01370 

DVNUM-0,  ITA01380 

DMCDE-0.  ITA01390 

DFOV-0,  ITA01400 
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DMhG=0.  ' 

A JOB=0 . 

TBhR=u . 

NAL=0 
TFNL=>t  . 

ILAST=0 

IFLGFV=0 

IFLGMG=0 

C  OUTPUT  LINE  COUNTER 

ILINE=0 

C  **■«:**  INITIALIZE  VALUES  < REPEATED  EXECUTIONS) 

C  *****  INPUT  CARD  COUNTER 

4  ICOV=0 

IF  < ILAST.NE. 0>  GOTO  6 
C  *****  FLAG  To  WRITE  TITLE 
ITITL=0 
TTOT=i . 

RC  =  0 . 

C=0  . 

ICM-0 

INEWD^O 

C  <■*>*.*♦  READ  A  CARD 

5  REAlu  lOIN,  900  )  IT<  1  3 ,  IT(.  2  ) ,  t' RV<  I  1  =  1 , 7  ) 

900  F0RMAT<2A2.6X,7F1 0.2) 

ICOV=ICOV+1 

IF<IT<1  ).EQ,IR<1  ).AND.IT<2>.EQ.IR<2))  GO  TO  €■ 

IF<  ITa  ).EQ.  IR<3).AND.  IT<2).EQ,  IR<4))  GO  TO  9 
IF<IT<1  ).EQ.IR<5).AND,IT<2).EQ.1R<6))  GO  TO  7 
IF<  IT<  1  )  .  EQ  .  Ih'<  7  )  .  AND  .  IT<  2  ) .  EQ  .  IR<  8  )  )  GO  TO  8 
IF  <  IT< 1  ).EO. IR<9).AND. IT<2).EQ.IR< 10)>  GOTO  2 
WRITE< IOOUT,901  )  IT< 1  ), IT< 2  ), < RV< I ), 1  =  1 , 7 > 

901  FORMAT< 1Xv61HTHE  FOLLOWING  CARO  DOES  NOT  CONFORM  TO 
•*-VENTI0NS,^1X,2A2,6X,7E1  0.3) 

IF< 1C0V.LE.5)  GO  TO  5 

IERR=1 

GOTO  1 

C  ALL  DONE 

6  IF  < ICOV.GT. 1 )  GOTO  3 

1  WRITE< IOOUT,902)  TFNL 

902  FORMAT<  1H0,5X.41H**>*  FINAL  TOTAL  TRANSMISSION  FROM  I 
RETURN 

C  ***4..(.  TARGET  CARD  PROCESSING  <TARV) 

7  RCHk=ACON 

IF<RV< 1  ),NE. 0. )  AC0N=RV< 1 ) 

IF<ACON.NE.RCHK)  IT1TL=1 
IF<RV<2).NE.  0.  )  S0G=RV<2) 

IF<RV<3).NE. 0. )  RNG=RV<3) 

IF< IGEOSW.NE. 1  )  GO  TO  477 

RNG-SORT<  <  PTS< 1  )-PTS<  4  )  J**2*< PTS<  2 )-PTS<  5  )  )*f2+<  PTS< 
477  CONTINUE 
RCHk=TARSZ 

IF<RV<4).NE. 0, )  TARSZ=RV<4) 

IF<TARS2.NE,RCH(<)  ITITL=1 
RCHK=U20NE 

IF<RV<5).NE. 0. )  UZ0NE=RV<5) 

IF<RCHK.NE.UZONE)  ITITL-1 
IF<RV<6),NE. 0. )  ALFLG-RV<6) 

IF<RV<7).NE.  0.  )  ALIGHT=RV<7) 

GO  TO  5 

C  *«««*  SENSOR  CARD  PROCESSING  < SENS ) 

8  IF<  RV< 1  )  . GT . 0 ,  )  PDET=RV< 1  ) 

RCHK-DVNUM 

IF<RV<2).NE. 0. )  DVNUM=RV<2) 

IF<DVNUM.NE,RCHK)  ITITL=1 
IF  <DVHUM.NE .RCHK)  INEUD-1 
RCHK=DMODE 

IF<RV<3>.NE. 0. )  0M0DE«RV<3> 

IF<DMODE.NE.RCHi<)  lTITL-1 
IF  < INEWD.EQ. 1 )  DFOV-O. 

IF  <INEUD.EQ.1)  IFLGFV=0 


ITAo i 4 1 u 
ITA01420 
ITA01430 
ITA01440 
ITA0i45u 
ITA01460 
ITAul 470 
ITA01480 
ITA01490 
ITA01500 
ITA0151 0 
ITA01520 
ITA01530 
ITA01540 
ITA01550 
ITA01560 
ITA0157U 
ITA015S0 
I TA 01 590 
ITA01600 
ITA01 61 0 
ITA01620 
ITA01630 
ITA0I640 
ITA01650 
ITA01660 
ITAOi 670 
ITA01680 
ITA0i690 
ITA01700 
ITA017i 0 
ITAM  INPUT  CONITA01720 
1TA01730 
ITA01740 
ITAOI 750 
ITAOI 760 
ITA01770 
ITA01780 
ITA01790 
TAM  =  ,F5.3)  ITA01800 

ITAOtSI 0 
ITA01820 
ITAOI 830 
ITAOI 840 
ITAOiSSO 
ITA01860 
ITA01870 
ITA01880 
3>-PTS<6))*=2)ITA01S90 
ITA01900 
ITAOi 91 0 
ITAOI 920 
ITAOi 930 
ITA01940 
ITA01950 
ITA0i960 
ITA01970 
ITA0I980 
ITAOI 990 
ITA02000 
ITA0201 0 
ITA02020 
ITA02030 
ITA02040 
I TA 02 050 
ITA02060 
ITA02070 
ITA02080 
ITA02090 
ITA021 00 
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\/>WOO  (OO 


,^>ND,  IFLGMC  .Eu.  1  > 
)  ITITL«t 


1FLGMG=0 


RCHK=OFOV 

1F<('V<4>.NE.0.  >  DF0V*PV<4> 

IF  t ftV<4  ),NE , 0.  . AND. IFLGFV.EQ . 1 >  1FLCFV=0 
IFCDFOV.NE.RCHK)  1TITL=1 
IF  < INEUD.EQ. 1 )  DMAG>0. 

IF  <INEWD.EG.1)  IFLCH&=0 
RCHK=DMAG 

IF<RV<5>.NE,  0.  >  DMAG=RV<5> 

IF  <RV<5>.NE . 0. . AND, IFLGMC .EG. 1 >  IFLGMG=0 

IF<DMAG.NE.RCHK)  ITITL«t 

RCHK=AJ0B 

IF<:RV<6).NE.  0.  )  AJOe=RV<E..> 

IF<AJOB.NE.RCHK>  ITITL-1 
GO  TO  5 

page  to  hew  header 

1T1TL«1 
GOTO  5 

«««*»•  BEGIN  PROCESSING  <  GO  ) 

FIRST  CHECK  IF  DEFAULTS  HEEDED,  AHD  SET  INTEGER  VALUES, 
ILAST=t 
RCHK»DVHUM 

IFC  OVNUM . EQ . 0 .  )  OVNUM=DVN 
IFcRCHK.NE.DVNUM;  ITITL=t 
LSC*=IFIX<DVNUM-».  0001  > 

IF  <  LSC , LT , 1  >  LSC=  1 
IF  <LSC.GT.14>  LSC=14 
RCHK=OMODE 

IF<DMODE.EQ.  0.  >  DMODE-DMD 
IF<RCHK.NE.DMOOE>  ITITL-1 
MODE=IFIX<OMODE+0, 0001  > 

IF<M00E.LT. 1 >  MOOE*1 
IF<M0DE,GT,2)  M0DE=2 
IF<PDET.EQ,0. >  PDET-PD 
PS-PDET 

IF<PS.GT.  1  .  )  PS=*1  . 

IF<PS.LT. 0. )  PS=0. 

RCHK*OFOV 

IF<  DFOV . LE . 0 . 0 . AHO . MODE , EQ . 1 >  DFOV=FOVW<  LSC  > 

IF<DFOV.LE. 0. O.ANO.MOOE.EQ.2)  DFOV=FOVN< LSC > 

IF<DFOV.LE. 0, 0)  IFLGFV-t 

IF< DFOV , LE , 0 . , AND . MODE . EQ , 1 >  OFOV»FV 

IF<  DFOV . LE . 0 . . AND . MODE . EQ . 2 )  DF0V*FV/2 . 

IF<RCHK.NE.OFOV>  ITITL=1 

FOV=DFOV 

RCHK^DMAG 

IF<  DMAG  .  LE  .  0 . 0  .  AND  .  MODE  .  EQ  ,  1  >  DMAG-AMACW<  LSO 

IF<DMAG.LE. 0. O.ANO.MODE.EG.2>  DHAG«AMAGN< LSO 

IF<DMAG,LE. 0. 0)  IFLGMG-1 

IF<OMAG.LE. 0. 0>  DMAG>OMG 

IF<RCHK.NE.OMAG>  1TXTL=1 

aMAC^DMAG 

RCHKaAJOB 

IF<AOOB.EQ.  0. 0>  AOOB-AJB 
1F<RCHK.NE.AJ0B>  ITITL-I 
RCHK*ACON 

IF< ACON.EQ. 0. 0>  ACON-ACN 
IF<RCHK.ME.ACON>  ITlTL-1 
C-ACON 

IFCSOG.EO. 0. 0>  SOG*SGR 
IF<RNG.LE. 0. 0)  RNG=RN 
R-RNG 

RCHK-TAR8Z 

IF<TARSZ.LE. 0. 0)  TARSZ-TGT 
1F<RCHK,NE.TAR82>  ITlTL-1 
01M-TARS2 
RCHK-U20NE 

IF<UZONE.LE.  0. 0)  UZ0HE«F0Vit<>*2 
IF<RCHK,NE.UZONE>  ITITL=1 
20NE-UZOHE 

IF  <ALFLC.LT. 0. >  ALFLG=0. 


0 . AMD . MODE , EQ . 1 >  DFOV=FOVW<  LSC  > 
0 . AND . MODE . EQ . 2  )  DFOV=FOVN<  LSC  > 
0)  IFLGFV-t 

.AND. MODE. EQ, 1 >  OFOV-FV 
.AND.M0DE.EQ.2)  DFOV-FV/2. 

■OV)  ITITL-1 


ITA021  1  0 
ITA02120 
ITA02130 
ITA02t40 
ITA02i50 
ITA021 60 
ITAG21 70 
rTA02180 
ITA02190 
ITA02200 
ITA0221 u 
ITA02220 
ITA02230 
ITA02240 
ITA02250 
I TA 02260 
ITAU2270 
ITA02280 
LIGHT  CAITA02290 
rTA02300 
ITA0231 0 
ITA02320 
I TA 02330 
ITAU2340 
ITA02350 
ITA02360 
ITA02370 
ITA02380 
ITA02390 
ITA02400 
ITA0241 0 
ITA02420 
ITA02430 
ITA02440 
I TA 02450 
ITA02460 
ITA02470 
ITA02480 
ITA02490 
ITA02500 
ITA0251 0 
1TA02520 
ITA02530 
ITA02540 
ITA02550 
I TA 02560 
ITA02S70 
ITA02580 
ITA02590 
ITA02600 
lTA026t0 
ITA02620 
ITA02630 
ITA02640 
ITA02650 
I TA 02660 
ITA02670 
ITA02680 
I TA 02690 
ITA02700 
ITA027I0 
1TA02720 
ITA02730 
rTA02740 
1TA02750 
ITA02760 
I TA 02770 
I TA 02780 
1TA02790 
ITA02800 
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IP  < rtLFLG . GT . 9 .  )  ALFLG=9 .  ITA02810 

IrtL=IFIX<ALFLG+0. 0001 )  ITA02820 

IF<1hL.GT,0)  AL=1 0 , 3-lAL . E-1 0  1TA02830 

IFUAL. EG.  O.l^ND. FLIGHT  ,EQ.  0.  0)  AL1GHT=ALV  ITA02840 

rF< IAL.EQ. 0>  AL=ALIGHT  ITA02850 

CHECK  AND  WRITE  PAGE  TITLE  HEADING  ITA02S60 

)  ILIHE=ILINE+1  ITA02670 

IF<  ITITL.EQ.  0.  AND,  ILINE.LE.48;>  GO  TO  11  ITA02880 

IF  <  ITITL.EG.  O.AND,  ILINE.GT.49>  WRITE  <100LIT,905>  ITA02890 

)5  FORMAT<1H  ,35X.28H*k  CONTINUED  ON  NEXT  PAGE  >**')  ITA02900 

URITE( I00UT,91 0>  ITA02910 

41X,43<  IH*  )/41X,  1H'»,41X,  1H«,M1X.  1H*,  2X.37HINVERSE  SITA02920 


FORMAT< IHOX 


STATIC  TARGET  DETECTION  MODEL ,  2X ,  1  Hii/4 1  X ,  1  Hf,  4  1  X ,  1  H*X4  1  X.  43<  1  H>*  >  )  ITA02930 

WRITE< lOOUT, 91 1 >  ITA02940 

FORMAT-:  1  HO.  64X,28HTARGET  INTRINSIC  CONTRAST  OR  >  ITA02950 

WRITE< I00UT.912i  LSC.ACON  ITA02960 

FORMAT<20X. 13HDEVICE  NUMBER . 4X . 1 2 , 32X , 22HTEMPERATURE  DIFFERENCE.  ITA02970 

*  2X.F7,3)  ITA029S0 

IF<M0DE.EQ.2)  UR1TE< lOOUT , 91 3 >  DIM  ITA02990 

FORMAT< 1H0. 19X. 1 1HFOV  TYPE  -  . 4X. 6HNARR0W. 24X. 28HMINIMUM  TARGET  DIITA03000 

♦MENSION  <M).2X.F7,3)  ITA0301 0 

IFCMODE  .EG  .  1  )UIRI  TE<  I OOUT  .  9 1  4  )D  IM  ITA0302  0 

FORMAT< IHO , 19X, 1 IHFOV  TYPE  -  . 6X. 4HWIDE. 24X. 28HMINIMUM  TARGET  D1MEITA03030 

*NSION  <M),2X.F7.3>  ITA03040 

IF< IFLGFV .EG . 0  )  WRITE< lOOUT , 9 1 5  )  FOV.AJOB  ITA03050 

FORMAT<  IHO.  1  9X.  9HF0V  <  DEG  •>.  5X .  F7 , 3. 24X,  27HACQUIS I T  ION  LEVEL  <50  PCITA03060 

-♦NT),3X.F7.3)  ITA03070 

IF<  IFLGFV.EQ,  1  >  WR I  TE<  lOOUT .  9 1 6  .1  FOV.AJOB  ITA03080 

FORMAT< IHO. 19X.9HF0V  < DEG  ) , 5X , F7 . 3. 1 X, 1 9H< ARB  I TR ARY  DEFAULT),  ITA03090 

*  4X.27HACQUISITI0N  LEVEL  <50  PCNT ) . 3X , F7 , 3 )  ITA03100 

IF< IFLGMG.EQ. 0)  WR1TE< I00UT,917)  AMAG.ZONE  ITA03110 

FORMAT< IHO. 19X. 1 3HMAGN IF ICAT ION, 2X . F6 . 3 , 24X , 24HSEARCH  ZONE  < DEGREE  1  TAOS  1 2 0 

•t-S>**2),6X.F7.3)  ITA03130 

IF< IFLGMG.EQ, 1 >  WRITE< lOOUT. 91 8 >  AMAG.ZONE  ITA03140 

FORMAT< IHO, 19X. 13HMAGNIFICAT10N,2X,F6. 3, IX, 19H< ARBITRARY  DEFAULT), ITA03150 

*  4X,24HSEARCH  ZONE  <  DEGREES-<-*>2 ).  8X.  F7 , 3 )  ITA03160 

WRITE  < lOOUT, 920)  ITA03170 

FORMAT< 1H0.52X,35HREauiRES  < TO  DEFEAT  DEVICE)  AT  MOST/  ITA03180 

*  4X. 14HF0R  NO  GREATER, 6X,5HUNDER,8X,3HAND,7X,2HAT,4X,  ITA03190 

*35<1H-))  ITA03200 

WRITE< I00UT,9I9)  ITA03210 

F0RMAT<8X,5HINPUT, 1 1 X, 5HINPUT, 7X, 5HIHPUT, 5X. 5HINPUT, 3X,  ITA03220 

*  8HC0MPUTE0,2X, 1 1HCOHTRAST  0R,3X,8HC0MPUTED/'6X,  ITA03230 

*  9HDETECTI0N,8X, 1 1HAMB,  ILLUM , . 2X. 1 OHSKY/GROUND, 2X,  ITA03240 

*  5HRANGE,2X, 1 OHRESOLVABLE, IX, 1 IHTEMP ,  DIFF , ,2X, 1 OHTOTAL  PATHITA03250 

*  /3X,5HPR0B.  ,2X,9HTIt1E<5EC>.3X,9H<FT  CDLS ),  5X,  5HRATI0, 5X,  ITA03260 

*  4H<KM),3X.10HCYCLES,  RC,2X,9HAT  DEVICE, 2X, 13HTRANSMITTANCE, ITA03270 


*  13X,8HC0MMENTS/'3X,5<  1H-  ),  2X, 9<  IH- >,  2X,  1  U  1 H-  ),  2X,  1  0<  1  H- 

*  1X,6<  1H-),2X,  1  0<  1H-).2X,9<  1H-),2X,  13<  1H-),2X,3  0<  IH-  )) 
ILINE-23 

C  ***,».,»  BEGIN  COMPUTATIONS  FCV.RC.TBAR 


S=DIM/'R 

IF  <FOV.LE. 0. )  FOV=, 0001 
TS=1 .7*Z0NE/F0V-»>»2 

IF<  ZONE  .  GT  ,  9 , 0  ,  AND  ,  FOV  ,  GT  .  5  .  )  TS=<  1 . 7i>Z0NE  )X<  5 , 0-«FOV  ) 

IF  <TS.LT, ,5)  TS=.5 

CALL  CVCLE<PS.PB,AJOB,RC) 

IF  <AL,LE, 0.  )  AL*1  ,E-7 
ALPRNT=AL 

IF  <LSC,Eu, 13)  GOTO  13 
TRAPaTi 

IF  <RC;LT. 0, 1  )  GOTO  14 

IF<  <  LSC . GT , 5 , AND . LSC , LT . 1 0 ) , OR . LSC . EQ , 1 1 , OR . LSC , EQ , 1 4 : 
RCS-RC 

PINF-1 .-EXP<-1 .7*RC3X6,8) 

IF  <PINF.LE,0,>  PINF=.0001 
TBAR=0 ,5*TS*<  2 . -PINF  VPINF 
CO  TO  14 

TBAR--0 . 5*TSk<  2 . 0-P9  ;XPS 
CO  TO  14 


10),OR.LSC.EQ,11 ,0R.LSC,EQ,14>  GO  TO 


1TA03280 
1TA03290 
ITA03300 
ITA0331 0 
1TA03320 
ITA03330 
ITA03340 
ITA0335O 
I TA 03380 
ITA03370 
ITA03380 
ITA03390 
I TA 034 00 
ITA034I 0 
ITA03420 
ITA03430 
ITA03440 
ITA03450 
ITA03460 
ITA03470 
ITA03480 
ITA03490 
1TA03500 


1 


i 


C  *****  DEVICE  #13 

13  NAL=t 
ICM«0 
PS=.99 
TBAE=*1  .  a 
C=ACOH 
TT0T=1 . 

TFNL=TTOT 

C  *****^COMPUTE  C  BASED  ON  AMBIENT  ILLUMINATION, 

14  IF  <a.LE. 0.  )  S=, 00  01 

IF  <RC. LT. 0. >  RC=0. 

RC=RC/S 

IF  <AMAG.LE.0,>  AMAG=,0001 
IF<LSC.EQ,  1  .0R.LSC.EQ.2>  RC=RC/‘AMAG 
IFtLSC,E0,2>  AL  =  0.7>t<AL 
C  *****  CORRECT  FOR  FIELD  OF  VIEW 

IF  <LSC.LT.6.0R.LSC.EQ.? j_GOTO  140 

IF  <  <  LSC  .  EQ  .  b  .  AND  ,  <  MODE  .  tO  .  2  i  )  RC=RC73. 

IF  <  <  LSC  .  EQ  ,  8  >  ,  AND  .  <  MODE  .  EQ  .  1  ,>  >  RC=RC"*3. 

IF  <  <  LSC  .  EQ  .  9  )  .  AND  .  c  MODE  .  EG  .  1  J  )  RC=RC’*4  . 

IF  <<LSC .EQ. 1 1 >. AND. (MODE .EQ. 1 )>  RC=RC*3. 

<  < LSC . EQ . 1 4  ) . AND . <  MODE . EQ . 1  >  >  kC=RC*3 . 

,  AND  , 


INTERPOLATE  IF 


140 


IF 

IF  <<LSC.EQ, 
<  <  LSC , 


IF 


II  > . 


.  bb!  . 


,  <  MODE  .  EQ  .  1  )  .^  RC=RC*8  , 
.2>>  RC=RC.'’4  . 


15 


_  __  1 2 > . AND . ( MODE . Eu 

CONTINUE 

IF<LSC.EQ.2>  IAL=0 
IF< lAL.GT. 0)  GO  TO  20 
AV-1 00, 

IF<AL .GT . 1 00  .  >  AL  =  100. 

DO  15  1=1,9 

IF<AL.GT.< 0.9O9*AV))  GO  TO  16 
AV=AV/'10. 

CONTINUE 
1=2 

IF  (LSC.GT.S)  GOTO  160 

NAL=0 

ICM=0 

GO  TO  22 

C  *****  CHECK  IF  INTERPOLATION  NEEDED,  IF  NOT,  GO  TO  20 

16  IF  <LSC.GT.5>  GOTO  160 
IF<AL.GT.< 1 . 001*AV>)  GO  TO  17 

160  IAL=I 

GO  TO  20 

C  *****  INTERPOLATE 

17  NAL 1=1-1 
NAL2=I 
ICM1-0 
ICM2*0 

CALL  INTAL<LSC,RC,C, AL,NAL1 ,NAL2, ICM1 , ICM2 , ALFA . BETA , GAMA , 
*AMRGM> 

NAL«0 

IFCNALI .EQ. 0.AND.NAL2.EQ. 0)  GO  TO  22 
NAL=NAL2 

IFCNALI .GT. 0)  GO  TO  18 

ICM=ICM2 

GO  TO  21 

18  IF<:NAL2.GT.  0>  GO  TO  19 
NAL=NAL1 

ICM=ICM1 
CO  TO  21 

19  IF< ICM1 .GT. O.AND. ICM2.GT. 0)  ICM«t 

IFdCMI  .LT.0.AND.ICM2.LT.0)  ICM=-1 

GO  TO  21 

C  *****  NO  INTERPOLATION  NEEDED 

20  NAL»IAL 

CALL  CINV< LSC, RC, NAL, C, ICM, ALFA, BETA, GAMA,  AMRAL,AMRGM> 

21  IF<  1CM.EQ.-1  )  C=.99«»C 

CALL  TREQ< ACON,SOG,C,LSC,TTOT> 

IF  < ICM.EQ. 1  )  TTOT  =  1  . 


ITA035i 0 
ITA03520 
ITA03d30 
I TA 03340 
ITAUJ330 
I  I  A  0^56  0 
ITAOa^/O 
ITAO338O 
ITA03390 
NECESSAITAOSbOO 
I  I  A0.i6  1  0 
I  Ta 0362  0 
ITAO^SaO 
ITA03640 
I TA 03630 
I TA 03660 
ITA036i'0 
I  TA 0368  0 
I  I  A03690 
iTA03700 
I  I  A 113?  1  0 
ITA03720 
I TA 03730 
I TA 03740 
I  TAOS.- 50 
ITA03760 
ITA03770 
I TA 03780 
ITA03790 
I TA 038 00 
ITA0381 0 
ITA03820 
I TA 05830 
I TA 03840 
ITA03850 
ITA03860 
I TA 03870 
rTA038S0 
ITA03890 
I TA 039 00 
ITA0391 0 
ITA03920 
ITA03930 
ITA03940 
ITA03950 
ITA03960 
ITA03970 
ITA03980 
I TA 03990 
AMRAL,  ITA04000 
ITA0401 0 
I TA 04 020 
I TA 04 030 
ITA04050 
ITA04040 
ITA04060 
ITA04070 
ITA04080 
ITA04090 
ITA041 00 
ITA041 1 0 
ITA04)20 
ITA04130 
ITA04140 
ITA04150 
ITA04160 
ITA04170 
ITA04180 
ITA04190 
ITA04200 
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1 


TFNL^TTOT 

C  PRINT  RESULTS 

22  IF<NRL.GT.0>  GO  TO  23 
TFNL=1  . 

URITE< IOOUT,930>  PS,  TBPR, ALPRHT,SOG,R,TFHL 
930  FORI1flT<3X,F5.3,F9.2,FM.6,F10.3,F9.2,4X,6<  1  H- > ,  7X ,  5<  1  H- )  ,  5X , 

*  F8. 3,  6X,28HN0TE-  AMBIENT  ILLUM.  0UTS1DE,^9  f  X, 

*  29HDEVICE  OPERATIONAL  LIMITS.  NOXSIX, 

>»  2tH0BSCURATI0N  REQUIRED  ./)  X  > 

ILlNE»lLINE+3 
GO  TO  4 

23  IF  <TTOT.GE. 1 . .AND, ICM.EQ. 0>  GOTO  24 

IF<ICM.EQ.0>  URITE< I00UT,931 >  PS, TBAR, ALPkNT, SOG , R, RC , C, TTOT 
IF<1CM.EQ.1>  WRITE< I00UT,932)  PS , TBAR , ALPRNT , SOG , R , RC , TTOT , C 
IF<ICM.EQ.O  ILINE  =  ILINE+6 

I F< I CM . Ed . - M  WR I TE< I OOUT , 933  >  PS , TB AR , ALPRNT , SOG , R , RC , C , T TOT 
1F<  ICM.EQ.-1  )  IHNE=ILINE  +  7 


GO  TO  4 

WRITE  <I00UT,934  )  PS , TBAR , ALPRNT, SOG, R, RC , C , TTOT 

FORMAT<3X,F5.3,F9,2,F14.6,F10.3,F9.2,F1 0.3,F12.3,5X,F8,3,6X, 

*  31HN0TE'  CONTRAST  < OR  TEMP.  DIFF.>/91X, 

*  31HREQUIRED  WOULD  EXCEED  INTR INS  I CXS 1 X , 

*  31HC0NTRAST  (TEMP,  OlFF.).  NO  0BS-/9IX, 

*  17HCURATI0H  REQUIRED/1 X> 

ILlNE=rLINE+3 

GOTO  4 

FORMAT<3X,F5.3,F9.2,F14.fa,F10,3,F9.2,Fl  li.3,F12.3,5X,FS.3) 
FORMAT<3X,F5.3,F9.2,F14.6,F10.3,F9.2,F1 0.3,7X,5< 1 H- ) , 5X , F8 . 3 , 6X , 

*  29HN0TE-  DETECTION  PROBABILITY  /91X, 

*  30HREQU1RES  CONTRAST  (OR  TEMP.  /91X, 

*  29HDIFF.)  AND  RESOLVABLE  CYCLES  /91X, 

*  27HAB0VE  LIMIT  FOR  DEVICE.  NO  /91X, 

*  26H0BSCURANT  REQUIRED.  DEVICE/91  X, 

13HUPPER  LIMIT  IS  C=>  ,F8.3/1X> 

FORMAT<3X,F5.3,F9.2,F14.6,F10.3,F9.2,F1 0.3,F12.3,5X,F8,3,6X, 

*  30HNOTE-  INPUT  DETECTION  PROBAB-  /91X, 

•»  30HIL1TY  REQUIRES  CONTRAST  (OR  /91X, 

*  30HTEMP.  DIFF.)  BELOW  THRESHOLD.  /91X, 

29HVALUES  ASSUMED  ARE  99  PERCENT/91  X, 

*  29H0F  THRESHOLD.  ADDITIONAL  OBS-/91X, 

*  29HCURANT  WILL  NOT  DECREASE  /91X, 

*  30HDETECTIOH  PROBABILITY.  /IX) 


ITA042t  0 
ITA04220 
ITA04230 
ITA04240 
ITA04250 
ITA04260 
ITA04270 
ITA04280 
ITA04290 
ITA04300 
ITA0431 0 
I TA 04320 
ITA04330 
ITA04340 
1TA04350 
I TA 04360 
ITA04370 
I TA 04380 
ITA04390 
ITA04400 
ITA044f  0 
ITA04420 
ITA04430 


ITA04440 
ITAU4450 
ITA044bO 
ITA04470 
ITA04480 
ITA04490 
ITA04500 
ITA0451 0 
ITA04520 
ITA04530 
ITA04540 
ITA04550 
1TA04560 
ITA04570 
ITA04580 
ITA04590 
ITA04600 
rTA0461 0 
ITA04620 


ITA04630 
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ai  r  *  r«  o  o  o  r « c  r*  r  •  r*  n  o  r « r*  o  o 


SUBROUTINE  C INV< LSC, RC , NAL , C , ICM, ALFA, BETA , GhMA. AMRAL , AMRGM > 
DIMENSION  ALFA<  9  >, BETA<  9  ), GAMA<  9  > , AMRAL<  6 , 3  > , AMRGMt  6 , 3  > 


CIN0001 0 
CIN00020 


COMMON  /lOUNIT/IOlN, lOOUT , I PHFUN , LOUNI T , ND I RTU , NCL 1 MT , KSTOR  ,  NPLOTUC I  NO  0 C3 0 


DATA  IPOS, INEG  /I , -1/ 

THIS  ROUTINE  COMPUTES  THE  REQUIRED  CONTRAST  AT  THE  DEVICE  FOR  A 
GIVEN  NUMBER  OF  RESOLVABLE  CYCLES  AT  THE  DEVICE,  EQUATIONS 
ARE  INVERSIONS  OF  THOSE  OF  THE  HV'iEOL  TARGET  ACQUISITION 
<FOR  STATIC  DETECTIONS  MODEL, 


INPUTS; 


OUTPUTS  I 


LSC 

RC 

NAL 


ICM 

NAL 


DEVICE  NUMBER  <1-i4> 
RESOLVABLE  CYCLES  < DECIMAL) 
AMBIENT  ILLUMINATION  CATEGORY 


1-9) 


CONTRAST  OR  TEMPERATURE  DIFFERENCE^ DEG  K)  REQUIRED 
BY  DtVICE  FOR  GIVtN  RC . 

OPERATIONAL  LIMITS  FLAG  <+1  EXCEEDS  LIMIT,  -1 
BELOW  LIMIT,  0  WITHIN  RANGE) 

SET  TO  0  IF  TOO  MUCH  OR  NOT  ENOUGH  AMBIENT  ILLUM. 


CFUN<  RX ,  ALF ,  BET ,  GAM  )=*<  BET+ALF*RX  >/<  GAM-RX  ) 

ICM=0 

IF<NAL , EQ . 0  )  GO  TO  9  020 
BRANCH  TO  LSC 

GO  TO  <10, 10, 30, 40, 50, 6 0,60, 80, 90, 100, 1111, 12 00, 9 06 0,14 00), 
10  GO  TO  <110,120,130,140,150,160,170,9060,9060),  NAL 
C  *****  DEVICE  #1  NAL  #1 


LSC 


1  1  0 


112 


IF< 2 . 74 . LT . RC )  GO  TO  9030 

IF<<2 . 133.LT.RC  ).AND .<RC .LE.2. 74 ))  GO  TO  112 
IF<<  .26795.LT,RC),AND.<RC.LE,2.133))  GO  TO  113 
IF<RC.LE. .26795)  GO  TO  114 
GO  TO  9000 


IEQ=1 

GO  TO  9050 

113  IEQ=2 

GO  TO  9050 

114  C»0,015 

GO  TO  9015 
C  *****  DEVICE  #1 


NAL  #2 


9030 
,<RC.LE, 


120  IF<2.74,LT.RC)  GO  TO 

IF<<2. 133.lt. RC), AND. 

IF<< .0001 .LE.RC).AND.<RC.LE. 
IF<  RC .LT .  . 0001  )  GO  TO  124 
GO  TO  9000 

122  IEQ=3 
GO  TO  9050 

123  IEQ-4 
GO  TO  9050 

124  C=0.025 
GO  TO  9015 

DEVICE  #1 


2,74  )>  GO  TO  122 
2.133))  GO  TO  123 


NAL  «3 


130  IF<2.29,LT.RC)  GO  TO  131 

IF<< 0.49585. LE.RC). AND. <RC.LE, 2. 29))  GO  TO 
IF<RC.LT. 0.49585)  GO  TO  133 
GO  TO  9000 

131  C=0.6324 
GO  TO  9035 

132  IEQ=5 

GO  TO  9050 

133  C=0.030 
GO  TO  9015 

*****  device  #1 


132 


NAL  «4 

140  IF< 1 .5219,LT.RC)  GO  TO  141 
IF<<  0.3 13. LE.RC). AND, <RC.LE. 
IF<RC.LT. 0.313)  GO  TO  143 
GO  TO  9000 

141  C=0.70 

GO  TO  9035 

142  IEQ=6 

GO  TO  9050 

143  C-0.05 


1.5219))  GO  TO  142 


CIN00040 

CIN00050 

ciNoooeo 

CIN00070 
C I N  0  0  08  0 
CiN00u90 
C I N  0  0 1 00 
CIN001 1 u 
CIH00120 
C I N  0  0 1  3  0 
C I N  0  0 1  4  0 
C I N  0  0 1  5  0 
CIN0016CI 
CIN001 70 
CIN00180 
CIN001 90 
CINu0200 
CIN0021 0 
CIN00220 
CInuD23u 
C I N  0  024  0 
C1N00250 
CIN00260 
CIN0u27u 
CIN0028U 
CIN00290 
CIN00300 
CIN0031 0 
CIN00320 
CIH0033U 
Cl  HO  0340 
CIN00350 
CIN00360 
CIN00370 
CIN00380 
CIN00390 
Cl  NO 04 00 
CIN0041 0 
CIN00420 
C1N0043U 
CIN00440 
CIN00450 
CIN00460 
CIN00470 
CIN00480 
CIN00490 
CIN00500 
CIH0051 0 
CIN00520 
CIN00530 
CIN00540 
CIN00550 
CIN00560 
CIN0U570 
CIN00580 
CINU0590 
CIN00600 
CIN0061 0 
CIN00620 
CIN00630 
CIN00640 
CIN00650 
CIN00660 
CIH00670 
CIN00680 
CIN00690 
CIN00700 
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GO  TO  9015 

C  DEVICE  «1  NhL  #5 

150  IF< 1 . 1959.lt. RC>  GO  TO  9030 

IF<< 0. O.LE.RC).AND,<RC.LE. 1 . 1959>>  GO  TO  152 
IF<RC.LT. 0.0)  GO  TO  153 
GO  TO  9000 

152  IEQ=7 

GO  TO  9050 

153  C=0 . 0841 
GO  TO  9015 

C  *****  DEVICE  #1  NAL 

160  IF< 0.44767. LT.RC)  GO  TO  9030 

It-<  <  0  ,  0309  .  LE  .  RC  ).  AND  .<  RC  .  LE  .  0 . 44767  >  )  GO  TO  162 
IF(RC .LT . 0 . 0309  )  GO  TO  163 
GO  TO  9000 
'62  ItUfS 

GO  lO  9050 
163  C  =  Cu18 

GO  I U  9013 

C  DEVICE  #1  NAL  #7 

i70  iF< 0 .  I  4 . LT . RC >  GO  TO  9030 

IF':  >.  0.05.LE.RC>.f>HD,<RC.  LE.O.  14))  GO  TO  172 
IFi;  ki,  .  LT  .  0  .  05  )  GO  ID  173 
GO  TO  9000 
1  ."2  >  EC'  =  9 


GO  TO  9050 
173  C=0.50 

GO  TO  9015 

*****  device  i3 

30  GO  TO  <9060,9060,9060,340,350,360,370,380,390), 
C  *****  device  i3  NAL  #4 

340  IF< 0, 7497, LE.RC, AND.RC.lt. 2.941 )  CO  TO  342 
IF  '.RC.GE.2.941  )  GOTO  9075 
I F<RC.LT. 0.7497)  GO  TO  9040 
GO  TO  9000 


342  IEC(=1 

GO  TO  9030 

C  DEVICE  *3  NAL  iS 

350  IF  < 0,3988. LE.RC. AND.RC.lt. 2. 4350)  GO  TO  352 
IF  <RC,GE,2.435)  GOTO  9075 
IF<kC,LT. 0.3988)  GO  TO  9040 
GO  TO  9000 

352  IE0=2 

GO  TO  9080 

•  *****  device  #3  NAL  #6 

360  IF  < 0, 15965. LE.RC. AND, RC.LT. 2. 1060)  GO  TO  362 
IF  <RC.GE,2.106)  GOTO  9075 
IF<RC, LT , 0 , 15965  )  GO  TO  9040 
GO  TO  9000 

362  I £0=3 

GO  TO  9080 

r  *****  DEVICE  #3  NAL  #7 

370  IF  < 0 . 05498 ,LE .RC .AND. RC .LT. 2 , 0375)  GO  TO  372 
IF  <RC.GE.2. 0375)  GOTO  9075 
IF< RC , LT . 0 . 05496  )  GO  TO  9040 
GO  TO  9000 

372  iEu=4 

GO  TO  9080 

C  *****  DEVICE  «3  NAL  #8 

IF  < 0,442, LE.RC. AND. RC.LT. 3. 2 190)  GO  TO  382 
IF  <RC.GE.3.219)  GOTO  9075 
IF<<RC.LT. 0,442  ). AND. <RC,GT.O, ))  GO  TO  383 
IF  <RC.LE, 0,  >  GOTO  384 
GO  TO  9000 
IE£I=5 

GO  TO  9080 
C=0.57 
GO  TO  9015 
C-0.33 
GOTO  9015 


38  0 

382 

383 

384 


NAL 


CIN007t  0 
CIN0U720 
CIN00730 
CIN00740 
CIH00750 
CINij0760 
CIN00770 
CIN00780 
CIN00790 
CINOOSOO 
Cl NO 081 0 
CIN00820 
CIN00830 
Cl NO 0840 
Ci  NO 085  0 
Cl  NO  0860 
CINu0S70 
CIN008S0 
Cl  NO 0690 
CIN00900 
Cl  NO  091 0 
CIN0u92Ci 
CIN00930 
CIN00940 
CIN00950 
CIN00960 
Cl HO  097  0 
CIH009S0 
Cl  NO 099  0 
CINOl 000 
CIN01 010 
CINOl 020 
CIH01 030 
CINOl 040 
CINOl 050 
CINOl 060 
CINOl 070 
CINOl 080 
CINOl 090 
C I N  0 1  1  0  0 
CINOl 1 1 0 
ciNonao 
CINOl 130 
CINOl 140 
CINOl 150 
CIHiit  160 
CINOl 170 
CINOl 130 
CINOl 190 
C I N  0 1  2  0  0 
CINOl 21 0 
CIN01220 
CIN01230 
CIN01240 
CINOl 250 
CINOl 260 
CINOl 270 
CIN01280 
CIN01290 
CIN01300 
C1N01310 
CIN01320 
C1N01330 
CIN01340 
CIN01350 
CIN01360 
C1N01370 
CIN01380 
CIN01390 
CIN01400 
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c  DEVICE  #3  NAL  #9 

390  IF  < 0. 172.LE.RC)  GO  TO  392 

IF^RC.LT. 0. 172.hND.RC.uT. 0. > 
IF  <RC.LE. 0,  )  GOTO  394 
GO  TO  9000 

392  IEQ=6 

GO  TO  9030 

393  C=0 . 57 

GO  TO  9015 

394  C=.33 
GOTO  9015 

C  *****  device  #4 

40  GO  TO  < 9060> 9060, 9060, 440, 450 
C  *****  DEVICE  #4  NHL  1*4 

440  IF  < 1 . 199. LE.RC.HND.RC.lt. 5. 2 
IF  <RC.GE.5.218>  GOTO  9075 
iF( RC . LT , 1 . 1 99 >  GO  TO  9040 
GO  TO  9000 
442  IEQ=1 

GO  TO  9030 

C  *****  DtVICE  #4  NHL  #5 
450  IF  < 0.64 02. LE, RC.HND.RC.lt. 4. 
IF  < RC . GE . 4 . 277 j  GOTO  9075 
IF< RC . LT . 0 . 6402 >  GO  TO  9040 
uO  TO  9000 
452  IEG!=2 

GO  TO  9080 

C  ♦***•  DEVICE  #4  NHL  #6 
460  it-  <  0 . 2449  .  LE ,  RC  .HND  .  RC  .  LT  .  4  . 
IF  <RC.GE.4. 124>  GOTO  9075 
IFCRC.LT. 0.2449)  GO  TO  9040 
GO  TO  9000 
462  1EQ=3 

GO  TO  9080 

C  *****  device  t4  NHL  #7 
470  IF  < 0. 08791 ,LE.RC.AND,RC.LT.3 
IF  <RC.GE.3.420)  GOTO  9075 
IFCRC.LT. 0. 08791  >  GO  TO  9040 
GO  TO  9000 
472  IEQ=4 

GO  TO  9080 

C  *****  DEVICE  #4  NHL  #8 
480  IF  < 0.4394. LE.RC. HND, RC.LT. 8. 
IF  <RC.GE.8,597)  GOTO  9075 
IFC  <  PX  . LT . 0 , 4394 ) . HND . <  RC . GT . 
IF  CRC.LE. 0, )  GOTO  484 
GO  TO  9000 

482  IEG=5 

GO  TO  9090 

483  C=0.33 

GO  TO  9015 

484  C=0.07 
GOTO  9015 

C  *****  DEVICE  #1  NHL  #9 
490  IF  < 0. 1605. LE.RC)  CO  TO  492 

IF<RC.LT. 0. 1605.HND.RC.GT. 0.  ) 
IF  <RC.LE. 0.  )  GOTO  494 
GO  TO  9000 

492  IEG=6 

GO  TO  9080 

493  C-0.33 

GO  TO  9015 

494  C=0,07 
GOTO  9015 

C  *****  DEVICE  «  5 

50  GO  TO  <9060,9060,9060,540,550 

540  IF  < 0.9189. LE.RC. AND. RC.LT. 2. 

IF  <RC.GE.2.806>  GOTO  9075 
IF<RC.LT. 0.9189)  GO  TO  9040 
GO  TO  9000 


GO  TO  393 


45  0 


Q  iliifc  >|t4e 

46  0 


470 


c  ♦♦  ♦♦ 
480 


,460,470,480,490),  NHL 
180)  GO  TO  442 


2770)  GO  TO  452 


1240)  GO  TO  462 


.4200)  GO  TO  472 


5970)  GO  TO  482 
0 ,  > )  GO  TO  483 


GO  TO  493 


,560,570,580,590).  NHL 
8060)  GO  TO  542 


CIN0141 0 
CIN01420 
CIN01430 
C1N01440 
CIN01450 
CIN01460 
CIN01470 
CIN01480 
CINu149D 
CIN01500 
CIN01 31 0 
CIN01520 
ClNul 530 
CIH01540 
C  IN01 550 
CIN01560 
CIN01 570 
CIN01580 
CInOI 590 
C I N  0 1  6  0  0 
CINulbt  0 
CIN01620 
CINOI 630 
C I N  0 1 64  0 
CINOI 650 
CIN01660 
CINOI 670 
CINOI 680 
CiN01690 
C1N01700 
CIN0171 0 
CIN01720 
CIN0t730 
C1N01740 
CIN01750 
CIN01760 
CIN01770 
CIN017S0 
CIN01790 
C I N  0  1  8  0  0 
CIN0181 0 
CIN01820 
CINOI 830 
CIN01840 
CINOI 850 
CIN01S6D 
CIN01870 
ClNOISdO 
CIN01890 
CIN01900 
CIN0191 0 
CIN01920 
CIN01930 
CIN01940 
C1N01950 
C1N01960 
CIN01970 
CIN019d0 
CIN01990 
CIN02000 
CIN0201 0 
CIN02020 
CIN02030 
CIN02040 
C1N02050 
CIN02060 
CIN02070 
CIN02080 
CIN02090 
CIN021 00 
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IEQ=1 

GO  TO  9080 

<•■*■■¥*  DEVICE  #5  NhL  #5 

IF  < 0,59035. LE.RC. AND. RC.LT, 2. 7010>  GO  TO  552 

IF  < RC . GE . 2 . 7 0 1 0 >  GOTO  9075 

IFCRC.LT. 0.59035)  GO  TO  9040 

GO  TO  9000 

IEQ=2 

GO  TO  9080 

»***.  DEVICE  #5  NAL  #6 

IF<  u. 2881 .LE.RC .AND.RC.lt. 2. 4800)  GO  TO  562 

IF  <RC  .GE.2.480)  GOTO  9075 

IF<:RC.LT.  0.2881  )  GO  TO  9040 

GO  TO  9000 

ItQ=3 

GO  TO  9030 

DfcVICE  #5  NAL  #7 

IF  <  0, 12943. LE.RC. AND. RC.LT.1 .6270)  GO  TO  572 

IF  c RC  .  GE . 1 . 627 )  GOTO  907b 

IF<RC,:.LT,  0.  12943)  GO  TO  9040 

GO  iQ  9000 

IEQf4 

GO  lO  9030 

1.*%*  device  #5  NAL  #8 

IF  < 0 . 4949 . LE , RC . AND , RC . LT ,2 . 6960 >  GO  TO  582 

IF  <Ri:  .GE.2,696)  GOTO  9075 

IF(RC:,LT,  0,4949,  AND.  RC.GT.  0.  >  GO  TO  533 

IF  <  RC . LE . 0 .  )  GOTO  584 

GO  TO  9000 

IE0“5 

GO  TO  9080 
C=0 ,33 
GO  TO  9015 
C=0. 07 
GOTO  9015 

DEVICE  #5  NAL  #9 

IF  < 0. 1894. LE.RC, AND. RC.LT. 3. 2898)  GO  TO  592 

IF  < RC  .  GE , 3 . 2898  )  GOTO  9075 

IF< RC.LT. 0.1 894, AND. RC. GT. 0. )  GO  TO  593 

IF  <RC.LE. 0.  )  GOTO  594 

GO  TO  9000 

IEQ=6 

GO  TO  9080 
C=0.33 
GO  TO  9015 
C=0. 07 
GOTO  9015 

.***  devices  #6  AND  #7 

iF< 1 .7934.LT.RC)  GO  TO  601 

IF<< 0,92376. LT.RC). AND. <RC.LE. 1 .7934))  GO  TO  < 

IF<<  0  ,  1  1  022. LE.RC  ).AND.<RC.LE. 0.92376))  GO  TO 

IF<RC,LT. 0. 1 1 022)  GO  TO  9070 

GO  lO  9000 

C=8.38 

GO  TO  9035 

C=<  ,  172363-fRC-O.  0392775 )/<  1 .82560-RC> 

GO  TO  9020 

C*<:  0.  09772*RC>/'<  1  . -0 , 34779'^RC  ) 

GO  TO  9020 
I.***  DEVICE  #8 

IF<4. 702. LT.RC)  GO  TO  801 

IF<< 0,996, LE.RC). AND, <RC,LE. 4. 702>)  CO  TO  802 

IF<RC.LT. 0.996)  GO  TO  803 

GO  TO  9000 

C»2 . 1 8 

GO  TO  9035 

C  =  <  0 . 02984RC  >7< 1  .-0. 1994RC) 

GO  TO  9020 
0*0 , 037 
GO  TO  9015 


1.7934))  GO  TO  602 
0.92376))  GO  TO  603 


CINu2i 1 u 
CIN02120 
CIN02t30 
CIN02140 
CIN02t50 
CIN02160 
CIN02170 
CIN02180 
CIN02190 
CIN02200 
CIN0221 0 
CIN02220 
CIN02230 
C1N02240 
CIN02250 
CIN02260 
CIN022<'0 
C  IN 0228  0 
CIN0229U 
CIN02300 
CINu231 0 
C1N02320 
eiN0233u 
CIN02340 
CiN02350 
CIN02360 
CINu23i'  0 
CIN02380 
CIN02390 
CIN02400 
CIN0241 0 
CIN02420 
CIN02430 
CIH02440 
C1N02450 
CIN02460 
CIN02470 
CINti2480 
CIN02490 
CIN02500 
CIN0251 0 
CIN02520 
CIN02530 
CIN0254CI 
CIN02550 
CIN02560 
CIN02570 
CIN02580 
CIN02590 
CIN02600 
CIN0261 0 
CIN02620 
C1N02630 
CIN02640 
CIN02650 
CIN02660 
CIN02670 
CIN02680 
CINu2690 
C1N02700 
CIN0271 0 
C1N02720 
CIN02730 
CIN02740 
CIN02750 
CIN02760 
CIN02770 
CIN02780 
CIN02790 
C1N02800 
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IS  LIMIHi^L  CONTRAST  ADJUSTMENT 


C  DEVICE  #9 

90  IF< 0.37181 .LE.RC. AND, RC.LT. 9. M027>  GO  TO  901 
IF  <RC.GE.9, 14027)  GOTO  9075 
IFCRC.LT. 0.37181 )  GO  TO  9070 
GO  TO  9000 

901  C=<  0. 0289fRC  ),-’<  1  .-0.  1  092+RC  ) 

GO  TO  9020 
C  DEVICE  #1 0 

100  IF(:NhL.GT,2)  go  to  9060 

IF<4. 227. LE.RC.AND.RC.lt. 91 . 05956)  GO  TO  1010 
If  < RC . GE . 91  . 05956  )  GOTO  9075 
C=0, 01 

C  NEXT  STATEMENT 
C=C/1 . 63 
GO  TO  9015 

1010  C=<  0 . 0303+RC )X<  13,43-0, 1 473*RC  > 

C  NEXT  STATEMENT  IS  LIMINAL  CONTRAST  ADJUSTMENT 
C=CX 1 . 63 
GO  TO  9020 

l~'  lit  Hr  )le  A  il  11 

Vl11  IF< 0.5057. LE.RC.AND.RC.lt. 7. 73353)  GO  TO  1110 
IF  <RC.GE.7.73353)  GOTO  9075 
GO  TO  9070 

1110  C=<  0. 0207*RC>X< 1.-0, 1291*RC) 

GO  TO  9020 
C  *****  DEVICE  «  12 
1200  IF<NAL.GT.2)  GO  TO  9060 

IF<3.48.LE.RC,  AND,RC..LT.31  .481 13>  GO  TO  1210 
IF  <RC.GE. 31 .41883)  GOTO  9075 
C=0. 01 

C  NEXT  STATEMENT  IS  LIMINAL  CONTRAST  ADJUSTMENT 
C=CX 1 . 63 
GO  TO  9015 

1210  C=><:  0 . 02  06*RC.  )/<  8 . 06-  0 , 2559'*«RC  ) 

C  NEXT  STATEMENT  IS  LIMINAL  CONTRAST  ADJUSTMENT 
C=CX1 .63 
GO  TO  9020 
C  *****  DEVICE  «  14 

1400  IF< 0.9098. LE.RC. AND, RC.LT. 4,5771 1 )  GO  TO  1410 
IF  <RC.GE,4.5771 1 >  GOTO  9075 
C=0, 037 
GO  TO  9015 

1410  C=<  0 . 0297567=*RC  )X<  0 . 91  287-0  .  1  991449»RC  > 

GO  TO  9020 

9000  URITE< IOOUT,901 0)  LSC.NAL.RC 

9010  F0RMAT<5X,46HBAD  PARAMETER  PASSED  TO  SUBRTN  CINV  ****  LSC« 
6H  NAL=  ,I3,5H  RC=  ,F10.4) 


,  13, 


9015 

9020 

9030 

9035 

9040 

9050 

9060 

9070 

9075 

9080 


ICM=INEG 
RETURN 
C-0,80 
ICM=IPOS 
GO  TO  9020 
C*=0.  02 
GO  TO  9015 

C»CFUN( RC , ALFA< lEQ  >, BETA< lEQ ), GAMA< lEQ ) ) 

GO  TO  9020 

NAL=0 

GO  TO  9020 
C-0. 01 12 
GO  TO  9015 
C-1 00. 

GOTO  9035 
L=LSC-2 

C-CFUN<RC, AMRAL< lEQ , L ), 0 , , ANRGM< IEQ,L>> 

GOTO  9020 

END 


CIN0281 0 
C  IN  02820 
CIN02830 
CIN02840 
CIN02ds0 
CIN02860 
CIN02870 
CIN02880 
CINU2890 
CIN02900 
CIN0291 0 
CIN02920 
CIN02930 
CIN02940 
CIN02950 
CIN02960 
CIN02970 
CIN02980 
CIN02990 
CIN03000 
CIN0301 0 
CIN03020 
CINO.}030 
CIN03040 
CIN0.1050 
CIN03060 
CIN03070 
CIN03080 
CIN03090 
CIN031 00 
CIN031 1 0 
CIN03120 
CIN03130 
CIN03140 
CIN03150 
CIN03160 
CIN03170 
CIN03180 
CIN03190 
CIN03200 
CIN0321 0 
CIN03220 
CIN03230 
CIN03240 
CIN03250 
C1N03260 
C1N03270 
CIN03280 
CIN03290 
CIN03300 
C1N0331 0 
CIN03320 
CIN03330 
CIN03340 
CIN03350 
CIN03360 
CIN03370 
CIN03380 
CIN03390 
CIN03400 
CIN0341 0 
CIN03420 
CIN03430 
CIN03440 
CIN03450 
CIN03460 
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) 
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SUBROUTIHh  INTALt  LSC  .  RC,  C  ,  hL,  MALI  .  NhL2,  ICHI  ,  ICM2,HLFH,BETH,ijHr1A, 

♦  AMRftL, AMRGM  > 

INTERPOLATION  ON  THE  SUREhCE  IN  C,  RC,  AMBIENT  ILLUMINATION  SPACE. 

THE  USER  INPUTS  A  VALUE  OF  RC,  AND  AN  AMBIENT  ILLUMINATION  THAT 
LIES  BETWEEN  ONE  PAIR  OF  MODELED  RC  VS  C  CURVES  AT  TWO  DISCRETELY 
MODELED  AMBIENT  ILLUMINATIONS.  THE  TECHNIOUE  IS  COMPLICATED  BY  A 
REQUIREMENT  TO  REPRODUCE  ALMOST  EXACTLY  THE  INTERPOLATED  VALUE 
FROM  RC  VS  C  OF  THE  NVL  TARuET  ACQUISITION  MODEL.  THUS,  WHILE 
RC  IS  INPUT  IN  THIS  INVERSION  MODEL,  THE  INTERPOLATION  IS  BETWEEN 
RC  VALUES  AT  CONSTANT  C  OVER  TWO  AMB .  ILLUM.  REGIONS.  THE 
THRESHOLDS  OR  OPEF;ATIOHAL  LIMITS  OF  THE  DEVICE  ARE  TREATED  SEPAR¬ 
ATELY.  IN  ALL,  FOUR  TYPES  OF  INTERPOLATION  SITUATIONS  ARE 
UTILIZED . 

DIMENSION  IftGHS>;  21  > ,  1NDEX<  21  >,  RCLC  25  >,  RCLK  23  CU<  2.5  >,  CL<  25  >, 
■*-IEQ1<36),  IEG2<36.^,RLW<36>,RUP<3fe>,CLU<36>,CUP<36>,ALFA<S), 
fBETAr  9  ) , GAMAC  9 ) , AMRALC  6 , 3  ? , AMRGM<  6,3) 

COMMON  XIOUMT/IOIN,  lOCUT,  IPHF'JN ,  LOUHIT ,  ND IRTU  ,  NCL I MT ,  KSTOR ,  HPLOTU 
NUMBER  OF  C  REGIONS  FOR  INTERPOLATION  CONSIDERATION,  DEV.  1-5 
DATA  IRONS  /4 , 4 , 3 , 3 , 2 , 2 , 1 , 1 , 1 , 2, I , 1 , 1 , 1 , 2 , 1 , 1 , 1 , 1 , 2 , 1 X 
H  STARTING  INDEX  FOR  EACH  DEVICE,  AMB, ILLUM.  PAIR. 

DATA  INDEX  X 1 , 5 , 9 , 1 2 , 1 5 , 1 7 , 1 9 , 2 0 , 2 1 , 22 , 24 , 25 . 26 , 27 , 28 . 30 , 3 1 , 
*32,33,34,367 

K  LOWER  LIGHT  LEVEL  THRESHOLDS  OF  RC . 


LOWER  LIGHT  LEVEL  THR 
DATA  RCL  7 
*.0001  ,. 26795, . 495S 
*, 15965, . 055  , .442 

*.1605  , .9139  .5903 


IN  I  0  0  0 1  u 
INT00020 
IHT00030 
INT00040 
INT00050 
INT00060 
INT00U70 
INT00080 
INT00090 
INT001 00 
I  NT  00 11 0 
I NTuul 20 
INT  0  0  1  30 
INTC0140 
^NTOOI 50 
INT001 60 
INT001 70 
INT001 80 
INT 00 190 
INT00200 
I  NT  0  021 0 
INT00220 
INT00230 
I  NT  0  024  0 
I  NT  0  025  0 
INT  00260 


u  . 

1.199 
.  1294 


UPPER  LIGHT  LEVEL  THRESHOLDS  OF  RC 


DATA  RCU  7 
*2.74  , 2 . 74 

♦2.106  ,2.037 
*3.597  ,2.806 
VALUE  OF  C  AT 
DATA  CL  7 


74  ,2,29  ,1.5.219,1,1951 
0375,3,219  ,3,219  ,5.218 
806  ,2,70?  ,2.43  ,1 .627 
AT  LOWER  THRESHOLDS. 

7 


.  0309 

, , 05  . , 7497 

, , 3988  , 

INT  0  027  0 

,6402 

, . 2449  , . 0879 

,  ,  4394  , 

INT00280 

.  4949 

, . 1 894  7 

INT00290 
INT00300 
IH7003i 0 

,44767 

,,14  ,2,941 

,2.435  , 

I NT 00320 

4.277 

,4,124  ,3,42 

,8,579  , 

INT00330 

2.696 

, 3 . 28987 

INT00340 

INT00350 
I  NT  0  0360 


♦  .015 

, . 025  , 

.  03  , 

.  05 

,  . 0841 

1  ,  .  18 

,  ,50 

,  .  02 

,  .  02  , 

.  02  , 

INt60370 

*  .  02 

,  ,57  , 

.57  , 

.  02 

,  .  02 

,  .  02 

,  .  02 

,  .  33 

,  .33  , 

.  02  , 

INT00380 

*  ,  02 

,  .  02  , 

.  02  , 

.33 

,  ,33 

7 

I  NT  0  039  0 

VALUE 

OF  C  AT 

UPPER 

THRESHOLD 

INT00400 

DATA 

CU  7 

INT0041 0 

*,80 

,  .80  , 

. 6324 , 

.70 

,  .80 

,  ,80 

,  .80 

,10  0, 

,100.  , 

100,  , 

I NT  0  042  0 

*100. 

.100.  , 

16,88, 

1  00  . 

,10  0. 

,100. 

,100. 

,100. 

,16.17, 

100.  , 

INT00430 

*100, 

,100,  , 

10  0.  , 

1  00  , 

,100. 

7 

INT00440 

INDEX  OF  MODEL  EQUATION  COEFFICIENT  INDICES  FOR  UPPER  AMB.  ILL. 

DATh  IEQI  72,2, 1 , 1 ,4,4, 3, 3, 5, 5, 0,6, 6, 0,7, 7, 8, 8, 1 ,2, 3, 4, 4, 5, 1 ,2,3, 

*  4,4,5,1,2,3,4,4,57 

INDEX  OF  MODEL  EQUATION  COEFFICIENT  INDICES  FOR  LOWER  AMB  ILL. 

DATh  IEQ2  7- 1,4, 4, 3, -',5, 5,  0,-1, 6, 6, -1,7, 7, -1,8. -1,9, 2, 3, 4, -1,5, 

*  6, 2, 3, 4, -1,5, 6, 2, 3, 4, -1,5, 67 
LOWEST  RC  VALUE  IN  EACH  REGION, 

DA  t  A  RLW  7 

*0.  ,.26794,2.118  ,2,133  26794, . 4958  ,1,8439,2.29  ,.312  , 

*,312  ,1.5119,0,  ,0.  ,1.1758,0.  , . 03 089 , . 03089 , . 05 

*,3937  ,.15964,. 054  ,.054  ,.442  ,.174  ,,64  ,.244  ,.087  , 

*.087  ,,4394  ,.1605  ,,59  ,,287  ,.129  ,.129  ,.4948  ,.1894  7 

LARGEST  RC  VALUE  IN  EACH  REGION, 


1  ,  8439,2 . 29  , 

. 03089, . 03089, 
,64  , .244  , 

.129  , .4948  , 


DATA  RUP 
* , 67890,2 , 


1335,2. 1637,2.74 


*2.29  ,2.29  ,,84083,1.5219,1.5219, 

*2.942  ,2.435  ,2,106  ,.9023  ,3.2)9  , 

•1.0396,8.597  ,8.597  ,2.81  ,2.71  , 

LOWEST  VALUE  OF  C  OVER  EACH  REGION. 
DATA  CLW  7 

*.015  ,,025  ,.250  ,.270  ,.025  , 

*.050  ,.6324  ,,050  ,.0841 07,. 70  , 

*.020  ,.020  ,.020  ,,020  ,.570  , 

*.020  ,.330  ,.330  ,,020  ,.020 

LARGEST  VALUE  OF  C  OVER  EACH  REGION. 
DATA  CUP  7 


2,133 

,2.5764, 

2.74 

,  .739 

J 

.7)2 

,  1  .  1959, 

.3751 

, .4477 

> 

3.2)9 

,5.2)8  , 

4.277 

,4.124 

f 

2.49 

, .9575  , 

2.696 

,3.29 

7 

.  030 

,.270  , 

.6324 

,  .  030 

* 

.  0841 

,  .  180  , 

.  180 

,  .500 

* 

.570 

,.020  , 

.  02  0 

,  .  020 

f 

.  020 

,.020  , 

.330 

,  ,330 

7 

INT00450 
INT00460 
INT00470 
INT00480 
I  NT  0  0490 
INT00500 
INT0051 0 
INT00520 
INT  00530 
INT00540 
INT00550 
INT00560 
INT00570 
INT00580 
INT0059U 
INT00600 
INT0061 0 
INT00620 
INT00630 
INT 00640 
INT00650 
INT00660 
INT00670 
INT00680 
INT00690 
INT00700 
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♦.025  ,.250  ,.270  ,.800  ,,030  ,.270  ,.6324  ,.800  ,,050  , 

♦.6324  ,.700  ,.084107,. 70  ,.800  ,.180  ,.800  ,.500  ,.800  , 

♦100.  ,100.  ,100.  ,.570  ,100,  ,16.88  ,100.  ,100,  ,100.  , 

♦.330  ,100.  ,16.17  ,100.  ,100,  ,100.  ,.330  ,100.  ,100.  7 

SET  LIGHT  LEVELS,  FRACTIONAL  INTERPOLANT. 

ICM1-=0 

ICM2=0 

IF  <NAL1 .EQ.HAL2>  GOTO  10 
IF  <LSC.GT.5>  GOTO  10 
AL1=1 0,^^<3-NAL1 > 

AL2=1 u , ♦♦<  3-NAL2 ) 

FAC.TR=<  AL-AL2  AL 1  -AL2  ) 

DFAC-1 .-FACTR 

GOTO  < 1 00, 100,200,200,200),LSC 

10  CALL  CINV<LSC, RC, MALI ,C, ICM1 , ALFA, BETA, GAMA, AMRAL,AMRGM) 

20  NAL2=0 

RETURN 

30  CALL  CINV<LSC,RC,NAL2,C, ICM2, ALFA, BETA, GAHA,AMRAL,AMRGM> 

40  NAL1=0 

RETURN 
DEVICES  1 , 2 

10 Cl  IF  <NAL2.LE.7)  GOTO  105 

Ii-  <  NAL1  .  EQ  .  7  .  AND .  FACTR  .  GT  .  0 , 75  )  GOTO  10 

NAL}=0 

GOTO  20 

105  NRG=IRGNS<NAL1 ) 

IDX=INDEX<NAL1  ) 

LIM1»NAL1 
LIM2=NAL2 
GOTO  500 
DEVICES  3,4,5 

200  IF  <NAL1.GE.4>  GOTO  205 

IF  <NAL2.EQ.4.AND.FACTR.LT.0.3>  GOTO  30 

NAL2=0 

GOTO  40 

205  IS=6+<LSC-3>*5+<NAL1-3) 

NRG=IRGNS< IS> 

IDX=»INDEX<  IS) 

L IM 1 =7+<  LSC-3 )*6*< NAL 1 -3  > 

LIM2=LIM1-*-1 

BVAL=0, 

I0V=LSC-2 

C^^  FIRST,  CHECK  LIMIT. 

500  IF  <RC.GE,RCL<LIM1  ).AND.RC.GE,RCL<LIM2>)  GOTO  510 

CALL  CASE3<FACTR,CN0T,RCN,RCL<LIM1  ), RCL< LIM2 >, CL< LIM1  ),CL<LIM2>) 

IF  <RC.GT,RCN>  GOTO  520 

CV=CNOT 

ICM1=-1 

ICM2=-1 

GOTO  800 

510  IF  <RC.LE.RCU<LIM1 ). AND.RC .LE.RCU<LIM2>)  GOTO  520 

CALL  CASE3<FACTR,CN0T,RCN,RCU<LIN1  ),  RCU<  L IM2  >,  CU<  L IM1  .),CU<LIM2)> 

IF  <RC.LT.RCN)  GOTO  520 

CV-CNOT 

ICM1=1 

ICM2-1 

GOTO  800 

C+^  RC  IS  IN  BOUNDS  OF  OPERATIONAL  LIMITS,  BUT  NOT  NECESSARILLY 
C  BETWEEN  CORVES.  TEST  SUB-REGIONS  IN  TURN. 

520  DO  600  I«1,NRG 
J-IDX+I-I 

IF  <RC.LT,RLL< J),OR.RC,GT.RUP< GOTO  600 
RC  IS  IN  SUB-REGION.  NOW  TEST  C 
CV*0. 

CRl-0. 

CR2-0. 

IQ1>IEQ1<  J> 

IQ2>IEQ2<J> 

IF  < IQ1 .GT. 0)  GOTO  530 
RCN=«RCU<LIM1  ) 


INT0071 0 
INT00720 
I NT 00730 
INTC0740 
INT00750 
INT00760 
INT00770 
INT00780 
INT00790 
INT00800 
INTOOdI 0 
INT00820 
INT00930 
INT00840 
INT00850 
INT00860 
INT00870 
INT00880 
INT00890 
INTOOSOO 
INT0091 0 
INT00920 
IHT00930 
I NT 00940 
IHT00950 
INT00960 
INT00970 
INT00980 
1NT00990 
INT01 000 
INT01 01 0 
INTOl 020 
INT01 030 
INTOl 040 
INTOl 050 
INTOl 060 
INTO! 070 
INTOl 080 
INTOl 090 
INTOl 1 00 
INTOl 1 1 0 
INTOl 120 
INTOl 130 
INTOl 140 
INTOl 150 
INTOl 160 
INTOl 170 
INTOl 180 
INTOl 190 
INT01200 
INT0121  0 
INT01220 
INT01230 
INT01240 
INT01250 
INT01260 
INT01270 
INT01280 
INT01290 
INT01300 
INT0131 0 
INT01320 
INT01330 
INT01340 
INT01350 
INT01360 
INT01370 
INT01380 
INT01390 
INT01400 
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53  0 


CNOT*CU(LIH1 ) 

IF  <IGI1.LT.0>  RCN=RCL<L1M1  > 

IF  (IQI.LT.O)  CNuT=CL<LIM1 >  , 

IF  <LSC.LE.2)  CALL  CASE2< FACTR , RC, CV, IFLG, Ck, RCN, CNOT, ALFA< IQ2 > , 
■»BETA<  1Q2>,GAMA<  IQ2>) 

IF  <LSC.GT.2>CftLL  CASE2< FACTR , RC , CV , IFLG , CP , RCN . CNOT . 
t<AMRAL<  IQ2,  IDV  ) ,  BVAL ,  AMRGM<  IQ2,  IDV>) 

IF  <IFLG.NE.O)  GOTO  600  ... 

IF  <CV.GT.CUP<  J).CjR.CV.LT.CLu»(  uOTu  6uu 
IF  <CP.GT.CUP<:  0>.OR,CP.LT.CLW<  J>>  GOTO  600 
IF  <RCN.EQ.RCU<LIM1 ;)  ICM1=i 
IF  <RCN.EQ.RCL<LIM1 )>  ICM1=-t 
GOTO  800 

IF  < IQ2,GT.O)  GOTO  540 
RCN=RCU<  LIM2  > 

CN0T=CU<LIM2> 

Ih  <IQ2.LT.0> 

IF  <  IQ2.lt . 0> 

IF  <LSC.LE.2) 


IQl  ), 


IF 

IF 

IF 

IF 


RCN=RCL<LIM2; 

CN0T=CL<  LIM2  :> 

CALL  CASE2<DFAC,RC,CV,  IFLG.,CP^RCN,CNOT,  ALFA' 

*BETA< IQl >,GAMA< IQ1 )> 

IF  <LSC.GT.2)CALL  CASE2< DFAC . RC , CV. IFLG , CP , RCN, CNOT , 
f AMRAL< IQl , IDV BVAL. AMRGIK  IQl , IDV ) ) 

IF  C  IFLG .HE. 0)  GOTO  600 

<CV,GT,CIJP<  J>.OR.CV.LT.CLU<  J>>  GOTO  6  00 
< CP . GT . CU?< J  )  . OR . CP . LT . CLU< J > >  GOTO  600 
<RCN.EQ.RCU<LIrt2))  ICM2=1 
< RCH . EQ . RCH L IH2 ) >  ICM2=-i 
GOTO  800 

54  0  IF< LSC . LE . 2  )CALL  CASEI <  FACTR,RC, CRl ,CR2, IFLG,  ALFA(  IQi  >, hLFA^ IQ2  >, 
t‘BETA<  IQl  ),BETA<  IQ2  ),GAMA<  IQl  ),GAMA<  1Q2  )  ) 

IF<LSC.GT.2>CALL  CASE1<FACTR,RC,CR1 ,CR2, 1FLG,AMRAL< IQl , IDV>, 
*AMRAL<  IQ2,  IDV  ),BVAL,BVAL,AriRGM<  IQt  ,  IOV>,  AMRGM<  IQ2,  IDV  >  > 

IF  < IFLG,GE.2)  goto  600 
CV=CR1 

IF  tCV.LE.CUPc J) , AND,CV.Ge.CLU< J>)  GOTO  800 

IF  < IFLG.EQ. 1 >  GOTO  600 

CV=CR2 

IF  <CV,LE,CUP<:  J).AND,CV.GE,CLUI<  GOTO  800 
600  CONTINUE 

C-f*  NO  VALUES  MET  INTERPOLATION  CRITERIA. 

C*f  FINAL  TEST  IS  IN  THE  LIMITING  REGIONS 
640  CONTINUE 

WRITE  <IOOUT,1000;  LSC,aL1,AL2 

1000  FORMAT< 1X,40H*f*  IN  ITAM  INTAL  ROUTINE,  DEVICE  LSC  =  ,12, 

*/lX,  43H’t'**  COULD  NOT  INTERPOLATE  BETWEEN  AMBIENT  ILLUM  ,  FI  1.6, 

*5H  AND  ,F1  1  .6/'1X,39H*t<*  UPPER  AMBIENT  ILLUM.  VALUE  ASSUMED.) 

GOTO  10 
800  C=CV 

RETURN 

END 


INTOI 41 u 
INT01420 
INT01430 
INT01440 
INT01450 
I  NT 01 46  0 
INT0t470 
INT01480 
INTU1490 
INT01500 
INT0151  0 
InT01520 
INT01530 
INT01540 
INT  Oi 5s0 
INT01560 
INT015<0 
INTOISSO 
INTOI 590 
1NT01600 
INT0161 0 
INT01620 
INT01630 
INT01640 
INTOI 650 
IHT01660 
INTOI 670 
INT0)680 
INTOI 690 
INT01700 
INT0171 0 
INT01720 
INT01730 
INT01740 
INT01750 
INT01760 
iNT01770 
INT01780 
INT  01 790 
INT01800 
INT0181 0 
INT01820 
INT  01830 
INT01840 
INT01850 
INT01860 
INT01870 
INTOI 880 
INTOI 890 
INT01900 
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ooooo 


SUBROUTINE  CASE t < FACTR, RC, CRl , CR2, IFLG, ALP1 , ALP2, BET1 , BET2, 
•kCAMI  .GAt12> 

FINOS  CONTRAST  C  INTERPOLATING  ON  RC  VS  C.  RETURNS  AT  MOST  TWO 
ROOTS  CRi,  CR2.  IFLG-1  IF  ROOTS  ARE  IDENTICAL.  IFLG=2  IF  ROOTS 
ARE  COMPLEX. 

DFAC-1 .-FACTR 

A1  «RC-GAM1  >l•FACTR-GAM2*0FAC 

A2»RCf<  ALP1  ♦ALP2  >♦<  BET  1  -ALP2'»GAM1  >*FACTR-K  BET2-ALP1  *GAM2  iJ^DFAC 

A3=ALP  1  *ALP2>*RC+ALP2>»BET  i  *FACTR+ALP  t  ♦BET2=*DFAC 

IFLG=2 

IF  <A1 .LT.-1 .E-10.0R.A1 .GT. 1 .E-10)  GOTO  10 

IF  < A2.EQ. 0.  >  RETURN 

IFLG=1 

CR1=-A3/^A2 

CR2=CR1 

RETURN 

10  DlSCR=A2»A2-4 .  ■•'A1*A3 

IF  <DISCR.LT. 0. >  RETURN 
IF  < DISCR . EO . 0 . )  IFLG=1 
IF  <DISCR.GT. 0. >  IFLG-0 
VA*SQRT<0ISCR)/'<2.<»A1  > 

VB»-A2/'<2.*A1  > 

SG—1  . 

IF  < A1 .LT. 0.  )  SG-1 . 

CR1*VB-fSG>*VA 

CR2-VB-SG*VA 

RETURN 

END 


CSAOOOl 0 
CSA00020 
CSA00030 
C3A00040 
C3A00050 
CSA00060 
CSA00070 
CSA 00080 
CSA00090 
C3A001 00 
C3A001 1 0 
CSA00120 
C3A00130 
CSA00140 
CSA00150 
CSA001S0 
CSA00170 
CSA00180 
C3A00190 
CSAOO2O0 
C3A0021 0 
CSA 00220 
CSA 00230 
CSA 00240 
CSA00250 
CSA 00260 
CSA 00270 
CSA00280 
CSA03290 
CSA00300 
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oooo 


SUBROUTINE  CASE2<FACTR.RC,C, IFLG, CP, RMOT, CNOT, hLP , BET, G^iM  ) 

FINDS  INTERPOLATED  CONTRAST  C  FOR  CASE  OF  SINGLE  FIXED  RC  AT 
SOME  LIMIT. 


1  0 

2  0 

25 

50 

bO 
90 
i  00 


IFLG=1 

IF  <FACTR.NE. 1 . >  GOTO  10 
IF  <RC.NE,RNOT>  RETURN 
GOTO  90 

IF  <RC.EQ.RNOT)  GOTO  25 

DIFF=RC-RNOT*FACTR 

IF  <DIFF.NE. 0, >  GOTO  20 

IF  <GAM.EQ.0.>  RETURN 

CP=BET,^GAM 

GOTO  50 

VA=eET*< 1 . -FACTR  >+ALP*DIFF 
vB=GAM*< 1 . -FACTR  j-DIFF 
IF  < VB.EQ. 0.  >  GOTO  90 
CP=VA^VB 
GOTO  50 

IF  <GAM,EQ.RC)  RETURN 
CP=<  ALP*RC+BET  GAM-RC  > 

GOTO  60 

RP=<  GAM»CP-BET  >X<  ALP+CP  > 

C=CNOT+<  CF-CNOT  >*< RC-RNOT  RP-RNOT  > 
GOTO  100 

C=CNOT%FACTR+CPk< 1 .-FACTR) 

GOTO  100 

C=CNOT 

CP=CNOT 

IFLG=0 

RETURN 

END 


CSBOOOl 0 
CSB00020 
CSB00030 
CSB00040 
CSB00050 
CSB00060 
CSB00070 
CSBOOOBO 
CSB00090 
CSB001 00 
CSB001 1 0 
CSBOOl 20 
CSBOOl 30 
CSBOOl 40 
CSB00i5u 
CSBOOl 60 
CSBOOl 70 
CSB00130 
CSBOOI 90 
CSB00200 
CSB0021 0 
CSB00220 
CSB00230 
CSB 00240 
CS600250 
CS600260 
CSB00270 
CSB00280 
CSB00290 
CSB 003 00 
CSB 0031 0 
CSB 00320 
CSB00330 


oooo 


SUBROUTINE  CASE3<FACTR,C,RCN,RH0T1 ,RN0T2,CN0Tt ,CN0T2) 

FINDS  INTERPOLATED  C  FOR  CASE  OF  BOTH  RC  VALUES  FIXED  AT 
LIMITS. 

RCN-RNOT1 *FACTR+RNOT2f< 1 . -FACTR  > 

IF  <RNuT1  .EQ.RNuTi'j  GOTO  10 

C»CN0T1i-<CN0T2-CN0Ti  >>*<RCN-RNOT1  >/<RN0T2-RN0T1  > 

RETURN 

1  0  C=CN0T1  •FACTR-*-CN0T2*<  1  .  -FACTR  > 

RETURN 

END 


C3C0001 0 
CSC00020 
CSC00030 
CSC00040 
CSCOOOSu 
CSC00060 
CSCu007u 

cscoooso 

CSCOOuSO 
CSC001 00 
CSC001 1 0 
CSC00120 
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SUBROUTINE  CTCLEc PS, PB, h JOB, RC >  CVCOOOIO 

CYC00020 

THIS  ROUTINE  COMPUTES  THE  NORMALIZED  NUMBER  OF  RESOLVABLE  CYCLES  CYC00030 

FOR  GIVEN  CUMULATIVE  NORMAL  DISTRIBUTION  OF  PROBABILITY  OF  CVC00040 

DETECTION.  CYCOOOsO 

CYC00060 

INPUTS:  PS  =  CUMULATIVE  PROBABILITY  OF  DETECTION.  CYCOOuZO 

PB  =  STANDARD  DEVIATION  FOR  PS  <  .632  >  CYCOOOSO 

AJOB  »  MEAN  RESOLVABLE  CYCLES  FOR  50  PERCENT  PROBABILITY  CYCOOOSO 

OF  DETECTION.  CYC001 00 

OUTPUTS:  RC  =  RESOLVABLE  CYCLES  REQUIRED  FOR  PS  CYC00110 

SUBROUTINE:  CYCLE  CALLED  BY  ITAM.  CALLS  NONE,  CYCOOIZO 

COMMON  /'lOUNITZIOIN, lOOUT , IPHFUH, LOUNIT , NDIRTU, NCLIMT, KSTOR , NPLOTUCYCO 0 1 40 
DATA  A0,A1,A2  Z2 . 5 1 53 1 7 , 0 . 802853 , 0 . 01 0328/  CYC00150 

DATA  81,82,83  / 1  .  432788 ,  0  .  1  89269 ,  0 . 001  308/  C.YC00160 

ICASE=0  CYC.00170 

IF< < 0 . O.LE .PS  )  .AND .<PS . LE. 0 . 0000003) >  GO  TO  10  CYC00160 

i(-<  <  .  SS999S7  .  LE  .  PS  )  .  AND  .  <  PS  .  LE  .  1  .  >  )  GO  TO  2  0  CYC00190 

IF<< ,0000003, LT, PS). AND, <PS.LE, 0.5))  CO  TO  30  CYC00200 

IF(  <■  .  5  ,  LT  ,  PS  >  .  AND  ,  iL  PS  .  LT  .  0 , 9999997  )>  GO  TO  40  CYC0021  0 

ERROR  routine  CyCO0220 

WRITEc IOOUT,900)  PS  CYC00230 

RETURN  CYC00240 

SPECIAL  CASE  I  CYC00250 

S  X=-5,  CYC00260 

IF  (PS.EQ.O.)  X=-45,  CYC00270 

GO  TO  60  CYC 00280 

SPECIAL  CASE  II  CYC00290 

i)  X=5.  CYC00300 

IF  <P3.ECi.1.>  XK45.  CYC 0  0310 

GO  TO  60  CYC 00320 

*****  CASE  I  CYC00330 

)  XX=SQRT<ALOG< 1/<PS*PS)>>  CYC 00340 

ICASE=1  CYC00350 

GO  TO  50  CYC 00360 

*****  CASE  II  CYC00370 

)  XX=»SQRT<  ALOG<  1  ./<  1  .-PS)’<"i>2>)  CYC00380 

3  X=XX-<  A0+A1  *XX+A2*<  XX'fXX  )  >/<  1  .  +B1  "•>XX+B2*<  XXfXX  )+B3*«:  XX>»XX*X.X  >  )  CYC00390 

IF< iCASE.EQ. 1  )  X=X*<-I.)  CYC00400 

3  RC=A  JOB+A  JOB’f'PBf'X  CYC004i0 

RETURN  CYC 00420 

30  F0RMAT<2X, 39HERR0R  -  INCORRECT  PS  VALUE  PASSED  PS  =  , FI  0.4)  CYC00430 

END  CYC00440 


THIS  ROUTINE  COMPUTES  THE  NORMALIZED  NUMBER  OF  RESOLVABLE  CYCLES 
FOR  GIVEN  CUMULATIVE  NORMAL  DISTRIBUTION  OF  PROBABILITY  OF 


DETECTION , 


INPUTS 


OUTPUTS 


CUMULATIVE  PROBABILITY  OF  DETECTION. 

STANDARD  DEVIATION  FOR  PS  <  .632  ) 

MEAN  RESOLVABLE  CYCLES  FOR  50  PERCENT  PROBABILITY 
OF  DETECTION. 

RESOLVABLE  CYCLES  REQUIRED  FOR  PS 


SUBROUTINE:  CYCLE  CALLED  BY  ITAM.  CALLS  NONE, 


t 
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SUBROUT  I NE  TRE£K  ACON , SCO  <  C  <  LSC , TRQ  > 

TRQ0001 0 

c 

TRQ00020 

c 

THIS  ROUTINE  COMPUTES  THE  TRANSMISSION  REQUIRED  TO  MATCH 

GIVEN 

TRQ00030 

c 

TARGET  AND  DETECTOR  CONTRASTS.  WITH  MODIFICATION  BY  SKY/ 

TRQ 00 040 

c 

GROUND  RATIO  FOR  MON-THERMAL  DEVICES. 

TRQ00050 

c 

TRQ00060 

c 

INPUTS!  ACuN  =  INTRINSIC  CONTRAST  OF  TARGET,  OR  TEMP. 

DIFF. 

TRQ00070 

c 

<t)EG  K)  FOR  THERMAL. 

TRQC0080 

c 

SOG  =  SKY./'GROUHD  RATIO. 

TRQ00090 

c 

C  =  CONTRAST  OR  TEMP,  DIFF.  SEEN  AT  DEVICE 

TRQOOl 00 

c 

LSC  =  DEVICE  NUMBER. 

TRQ 001 1 0 

c 

OUTPUTS!  TRQ  »  REQUIRED  TRANSMISSION  TO  REDUCE  ACON  TO 

C . 

TRQ00120 

c 

SUBROUTINE!  TREQ  CALLED  BY  ITAM.  CALLS  NONE. 

TRQ00130 

c 

TRQ00140 

COMMON  /'lOUNIT/'IOIN,  lOOUT,  IPHFUN,LOUNIT,NDIRTU,NCLIMT 

,KSTOR, 

NPLOTUTRQ00150 

IF<<LSC .LT . 1  ).OR .<LSC .GT . 14 ))  GO  TO  30 

TRQ00160 

IF<LSC.GT.5)  GO  TO  2u 

TRQOOl 70 

c  NON-THERMAL 

TRQCOIdO 

1  0 

IF  <SOG.EQ.O.  .OR.  C  .  EQ . 0 .  >  GOTO  43 

TRQ00190 

TRQ=  1  .  ,'<  1  .  +<  <  ACON-C  )/<  CiiSOG  )  >  ) 

TRQ00200 

GOTO  50 

TRQ0021 0 

20 

IF<<LSC.EQ.10).OR,<LSC.EQ.12))  GO  TO  10 

TRQ0D220 

IFcLSC . EQ . 1 3 )  GO  TO  30 

TRQ00230 

C 

*****  THERMAL 

TRQ 00240 

IF  (ACON.EQ. 0. )  GOTO  25 

TRQ 00250 

TRQ=C.^ACON 

TRQ00260 

GOTO  30 

TRQ00270 

25 

TRQ=1 . 

TRQ00260 

GOTO  50 

TRQ00290 

C 

*****  ERROR  ROUTINE 

TRQ00300 

30 

URITE< lOOUT, 1 00)  LSC 

TRQ0031 0 

TRQ=1 . 

TRQ00320 

100  FORMAKSX,  19H INPUT  ERROR  LSC  =  ,12> 

TRQ 00330 

RETURN 

TRQ 00340 

45 

TRQ=0. 

TRQ00350 

50 

IF  <TRQ.LT.O. )  TRQ-O. 

TRQ00360 

IF  <TRQ.GT. 1 .  )  TRQ»1 . 

TRQ00370 

RETURN 

TRQ00380 

END 

TRQ0O39O 
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SUBROUTINE  FCLuUlh'  LhHBDh ,  TRhNS ,  lERR 
REAL  LAMBDA, KAPPA. LBO, LP 

REAL  L,M,N,LO,MO,NO.LOS,MOS.N03,LOM,LCiW,NCM,MXLy,NXL2,MZNY 
DIMENSION  IALPH<10) 

COMMON  /lOUNIT/'IOIN,  lOOUT,  IPHFUN ,  LO'JNI  T  ,  ND  I RTU ,  NCL I MT ,  KSTOR  ,  NPLu 
COMMON  .■'FGEOM.'XC  ,  YC  ,  ZC  ,  AE  ,  BE  ,  CE  ,  XR  ,  YR  ,  2R ,  XS  ,  YS  ,  2S 
COMMON  XOPTX  I NDEXP , ET A , KAPP A . U 0 . THET A  0 , PH  I  0 , LD , TAUBAR , 

+RHO, LBO, TMPA, TMPC 
COMMON  XGEOMETXPTS<  15  i.IGEOSui 
DATA  IZERO.-'OX 

DATA  IALPHX2HCP  . 2HRP  ,2HSP  , 2HAx  .2HCL  ,2HAi  ,2HBk 
+2HSA  ,2HLU  ,2HG0  / 

ACDS<  ARG  >  =  ATAN2i;  SORTt  1  .  -ARG  +  ^Z  ) ,  ARC  I 

SUBROUTINE  FCLOUD  COMPUTES  THE  FOLLOWING  QUANTITIES  FOR  A  FINITE 
kLLIPSuIDAL  CLOUD i 

S  =  LENGTH  OF  OPTICAL  PATH  IN  CLOUD 
TRANS  =  BEAM  TRANSMITTANCE  THROUGH  CLOUD 
LP  =  PATH  RADIANCE 
TC  =  CONTRAST  TRANSMITTANCE. 

INPUT  OF  COMPUTATIONAL  PARAMETERS  TAKES  PLACE  THROUGH  AN  ORDER 
INDEPENDENT  READ  OF  A  GROUP  OF  RECORDS  IDtNTii-ItD  BY  THE  FOLLOWING 
MNEMONICS  <EAOH  RECORD  IS  FORMAT  < A4 , i X , 5< £  1 0 , 4 . 1 X > >  )  ; 


HLL 

FCL 

FCL 

FCL 

TUFCL 

FCL 

FCL 

FCL 

FCL 

FCL 

FCL 

FCL 


UUUl  u 

nno20 

00030 
00040 
0  0  050 
00060 
0  0  070 
00080 
0  0  090 
00100 
0  u  1  i  0 
0  012  0 


c 

c 

MHEUMOHiC 

VARIABLES 

READ 

DESCRIPTION 

c 

c 

CPOS 

XC. VC,2C 

CLOUD  CENTER  POSITION 

i*' 

RPOS 

.XR,YR,ZR 

RECEIVER  POSITION 

c 

SPOS 

XS,YS,2S 

SOURCE  POSITION 

c 

AXES 

AE.BE.CE 

SEMI-AXES  OF  CLOUD  ELLIPSOID 

c 

CLDS  I NDEXP 

, ETA. KAPPA 

, WO. TMPC  CLOUD  AEROSOL  PARAMETERS 

c 

ATMO 

TAUBAR, TMPA 

ATMOSPHERIC  PARAMETERS 

C 

BKGR 

RHO.LBO 

BACKGROUND  PARAMETERS 

c 

SANG 

THETAO, PH 

10 

SOLAR  ANGLES 

c 

LUND 

LD 

LUNAR  DAY 

c 

GO 

TERMINATES  READ 

c 

**  NOTE  !  THE  GO  SENTINEL 

CARD 

MUST  BE  THE  LAST  CARD  READ 

c 

THIS  INPUT  DATA 

IS  STORED 

FOR 

LATER  USE  IN  COMMON 

c 

BLOCKS  XFGEOM,' 

AND  XOPTX. 

c 

XFGEOM/  INPUT  PARAMETERS : 

c 

';XC.YC,ZC?  = 

CENTER  OF 

ELLIPSOID 

c 

<AE,BE,CE?  = 

SEMI-AXES 

OF  ELLIPSOID 

c 

<XR,YR,2R?  = 

COORDINATES  OF 

RECEIVER  LOCATION 

c 

<XS,YS,2S?  = 

COORDINATES  OF 

SOURCE  LOCATION. 

c 

/OPT/  INPUT  PARAMETERS: 

INDEXP  =  PHASE  FUNCTION  IDENTIFIER 
*0,  USER  SUPPLIED 

*1.  MARITIME  ARCTIC.  VIS=0,1  TO  2.0  Kf 

=2,  MARITIME  POLAR,  VIS=0.2  KM 

«3.  MARITIME  POLAR,  VIS=02,  KM 

=4,  CONTINENTAL  POLAR,  VIS=  0.2  TO  2.! 

=5,  WHITE  PHOSPHORUS 

-6,  HEXACHLOROETHANE 

*■7,  FOG  OIL 

«8,  DUST  < MODERATE  AEROSOL  LOADING? 

=9,  DUST  < HEAVY  AEROSOL  LOADING? 

«10,  MARITIME  MODEL  B,  VIS=5KM,  RH=95X 
=t1,  MARITIME  MODEL  B,  VI S= t OKM , RH=9 OK 


%’CFCLOOI  30 
FCLOul 40 
FCL  0  015  0 
t-CLuui  bO 
FCLOOl 70 
FCL 001 80 
F  CL  0  0 1 9  0 
FCL 002 00 
FCL 0021 0 
FCL 00220 
FCL 00230 
FCL00240 
FCL00250 
FCL00260 
FCL 0  027  0 
FCL0028U 
FCL 00290 
FCL 003 00 
FCL0031 0 
FCL00320 
FCL00330 
FCL 00340 
FCL 00350 
FCL00360 
FCL00370 
FCL00380 
FCL00390 
FCL 004 00 
FCL  0  04 1  0 
1-CL00420 
FCL 00430 
FCL00440 
FCL00450 
FCL004B0 
FCL00470 
FCL  00480 
FCL 00490 
FCL 00500 
FCL 0051 0 
FCL 00520 
FCL 00530 
FCL00540 
FCL 00550 
FCLOOobO 
FCL00570 
FCL005S0 
FCL00590 
FCL00600 
FCL0061 0 
FCL00620 
FCL00630 
FCL00640 
FCL00650 
FCLC0660 
FCL00670 
FCL00680 
FCL00690 


0000000000000000000000000000000000000000000000000000000000000000000000 


*12,  MARITIME  MODEL  B,  VIS=5oi<^M,  RH=50'-: 

ETA  *  FORWARD  SCATTERING  PARAMETER 

ETA  MAY  ALSO  BE  CALCULATED  BY  DEFAULT  <I.E.  INPUT  ETA  =u.u) 
IN  THIS  CASE  INDEXP  SHOULD  BE  THE  NEGATIVE  OF  THE  PHASE 
FUNCTION  FOR  WHICH  ETA  IS  DESIRED. 
kappa  =  VOLUME  EXTINCTION  COEFFICIENT  <KM-1> 

WO  =  SINGLE  SCATTERING  ALBEDO 
<THETAO,PHIO)  =  SOLAR  ANGLES  <DEGREES> 

LD  =  LUNAR  DAY  (INTEGER  BETWEEN  0  AND  28) 

TAUBAR  =  ATMOSPHERIC  OPTICAL  THICKNESS  ABOVE  CLOUD 

RHO  =  BACKGROUND  SURFACE  ALBEDO 

LBO  *  BACKGROUND  RADIANCE 

TMPA  =  TEMPERATURE  OF  ATMOSPHERE  (DEG.C) 

TMPC  =  TEMPERATURE  OF  CLOUD  (DEG.C). 

ALL  LENGTH  UNITS  ARE  KM.  PROGRAM  FLOW  IS  CONTROLLED  BY  THE 
VARIABLES  TMPA,  IHDEXP,  AND,  IMPLICITLY,  BY  ISW  . 

IF  TMPA  >=  -89.0,  THIS  SPECIFIES 

A  THERMAL  COMPUTATION,  WHICH  IS  PERFORMED  IN  SUBROUTINE  THRMCL ! 

IF  TMPA  <  -98.0  THEN  A  SCATTERING  COMPUTATION  IS  PERFORrtEO  . 

IF  INDEXP  <  0,  THIS  IS  A  MULTIPLE  SCATTERING  COMPUTATION,  WHICH 
IS  DONE  IN  SUBROUTINE  MSCLDj  IF  ETA  HAS  BEEN  INPUT  AS  ZERO,  THEN 
INDEXP  SHOULD  BE  THE  NEGATIVE  OF  THE  PHASE  FUNCTION  INDENTIFIER, 
SO  THAT  ETA  WILL  BE  FOUND  FROM  THE  PROPER  PHASE  FUNCTION. 

IF  INDEXP  >  0  A  SINGLE  SCATTERING 
COMPUTATION  IS  CARRIED  OUT  IN  SUBROUTINE  SSCLD .  IN  THIS  CASE 
INDEXP  ALSO  SPECIFIES  THE  PHASE  FUNCTION  TO  BE  USED,  WITH 
INDEXP  =  I  SELECTING  THE  I-TH  PHASE  FUNCTION,  THE  VALUE  OF 
ISW  OCCURRING  IH  THE  SUBROUTINE  PARAMETER  LIST  INDICATES  WHETHER 
CERTAIN  parameters  ARE  THE  SAME  AS  IN  THE  PREVIOUS  CALL  TO  FCLOUD, 

AS  FOLLOWS. 

ISW  IS  SET  TO  0  WHEN  THE  FOLLOWING  CONDITIONS  ARE  ENCOUNTERED  ! 

A)  ALL  9  DATA  CAROS  ARE  READ 

B)  ANY  ONE  OF  CARDS  1-4  AND  ANY  ONE  OF  CARDS  5-9 

(AS  LISTED  IN  THE  ORDER  ABOVE)  ARE  READ 

IS  SET  TO  2  IF  NONE  OF  CARDS  1-4  IS  READ. 

IS  SET  TO  1  IF  NONE  OF  CAROS  5-9  IS  READ. 


ISW 
ISW 

ISW  DEFAULTS  TO  2  IF  NOTHING  IS  READ  (OTHER  THAN  THE  GO  CARD). 


ISW  =  2  =>  PARAMETERS  IN  COMMON  XFGEOM/  ARE  THE  SAME  AS 
PREVIOUS  CALL!  SKIP  PRELIMINARY  GEOMETRICAL 
CALCULATIONS 

ISW  »  1  =>  PARAMETERS  IN  COMMON  /OPT/  ARE  THE  SAME  AS  IN 
PREVIOUS  CALL!  SKIP  COMPUTATIONS  INVOLVING 
ONLY  THESE  PARAMETERS 

ISW  =  0  =>  NEW  PARAMETERS  IN  BOTH  /FGEOM/  AND  /OPT/i 
NO  CALCULATIONS  ARE  SKIPPED  IN  THIS  CASE, 

SUBROUTINES  CALLED  FROM  FCLOUD i 

THRMCL  FOR  THERMAL  CALCULATION  OF  PATH  RADIANCE 

MSCLD  FOR  MULTIPLE  SCATTERING  CALCULATION  OF 

PATH  RADIANCE 

SSCLD  FOR  SINGLE  SCATTERING  CALCULATION  OF  PATH 

RADIANCE 

ILLUM  COMPUTES  THE  EXTRATERRESTRIAL  SOLAR  OR 

LUNAR  IRRADIANCE,  NOT  NEEDED  FOR  THERMAL 
CALCULATIONS 

PFN  RETURNS  A  PHASE  FUNCTION  VALUE  FOR  USE  BY 

SSCLD. 

GROUND  RADIANCE  CAN  BE  SPECIFIED  IN  ONE  OF  TWO  WAVS; 

1. )  BV  GIVING  LBO  A  NONZERO  VALUE,  OR 

2. )  AS  REFLECTED  SOLAR  IRRADIANCE,  USING  THE  VALUE  OF 

RHO  INPUT  TO  THE  PROGRAM. 

THE  VALUE  OF  LD  SPECIFIES  WHETHER  IT  IS  DAY  OR  NIGHT,  I.  E. 
WHETHER  SOLAR  OR  LUNAR  EXTRATERRESTRIAL  IRRADIANCE  IS  TO  BE 
USED.  IF  LO  =  0  THEN  SOLAR  IRRADIANCE  IS  CALCULATED,  AND  IF 


IH 


FCL00700 
FCL0071 0 


FCL00720 
FCL00730 
FCL00740 
FCL00750 
FCL 00760 
FCL0O770 
FCL00780 
FCL00790 
FCL00800 
FCLOOei 0 
FCL00820 
FCL00S30 
FCL00840 
FCL00850 
F CL  0066  0 
FCL0U870 
FCL00880 


FCL00890 
FCL 00900 
FCL0091 0 
FCL00920 
FCL00930 
FCL00940 
FCL 00950 
FCL 00960 
FCL00970 
FCL 00980 
FCL00990 
FCL01 000 
FCL01 01 0 
FCL01 020 
FCL01 030 
FCL01 040 
FCL 01 050 
FCL 01 060 
FCL01 070 
FCL01 080 
FCL01 090 
FCL01 1 00 
FCL01 1 1 0 
FCLOl 120 
FCLOl 130 
FCLOl 140 
FCLOl 150 
FCLOl 160 
FCLOl 170 
FCLOl 180 
FCLOl 190 
FCL01200 
FCLOl 21 0 
FCL01220 
FCL 01 230 
FCL01240 
FCL01250 
FCL01260 
FCL01270 
FCL01280 
FCL01290 
FCL01300 
FCL0131 0 
FCL01320 
FCL01330 
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A0*A114  417  ARMY  ELECTRONICS  RCSCARCH  ANO  DEVELOPMENT  COMMAND  VS— ETC  F/8  n/1 

PROORAM  LISTINGS  POR  COSAEL  00-®  ANO  ANCILLARY  COOES  AOAUS  ANH  — ETC(U) 
FEB  02  R  0  STEINHOPp 

unclassified  ERAOCOM/ASL-TR-O107-V2-SU  NL 


u  +  >t>  +  + 

r 

C  IN 
C 


LD  <  28  THE  IkkhDIhHCE  VhLUE  IS  PuR  LUNAR  DAY  LD , 


ITiALIZATION  OF  INPUT  DATA. 

IF  <I2EkO.NE.O>  write  <I00UT,99> 

FORMAT":  1  HI  ) 

If<.  12tR0  .  NE  .  0  >  GO  TO  477 
XC-'j  .  u 
yC=u . 0 
20= u. 0 
j<R=u  .  0 
Yft=0 . 0 
2k=0 . 0 
xS=0 , 0 
yS=u . 0 
2S=0 , 0 
At=0  .  0 
BE  =  L!  .  0 
CE=u . 0 
inde;';p=o 
E  1  A=  u  .  u 
KAPFA=0 , 0 
w0=0 .  0 
TMPC=0. 0 
TAUfc!AR=0  .  0 
TMPA=0  ,  Cl 
RHCi=Ci .  0 
L6  0=Ci .  0 
THETA0=0 . 0 
Pril 0=0 . 0 
LD  =  0 
ISW=0 
IZ£F.0=  < 

CON r I HUE 

IFLG=2 

IFLO=l 

DO  360  K=1 , 1 0 

READ< I0IN,334)IA, IA2,R1 ,R2,R3,R4,R5 
FORM AT<  2A2 ,  1  X .  5<  E  1  0 , 4 1  X  )  > 

DO  333  1=1,11 

IF<  IA.NE.  lALPHC  O)  GO  TO  333 
IND=I 

Ir-<  IND  .  EQ  .  1  0  >  GO  TO  361 
CONTINUE 

1F<K,EQ.10.AND.IND.NE.10)  GO  TO  358 
IF<  IND.LT.5>IFLG  =  0 
IFC IND.GE.S. AND, IND . LE . 9 )1FL0=0 
IF< IND.EQ. 11)  GO  TO  355 

IFC iND.LT.5)  GO  TO  < 341 ,342,343,344), IND 
IHDM4=IND-4 

GO  TO  <345, 346, 347, 348, 349), INDM4 

XC=R1 

YC=E2 

ZC=R3 

GO  TO  360 

XR=R1 

YR=R2 

2R=R3 

GO  TO  360 

XS*P1 

Y3=R2 

Z3=R3 

GO  TO  360 

AE=R1 

BE=R2 

CE=R3 

GO  TO  360 

IHDEXP=IF1X<R1  > 


F CL  01 34  0 
FCL01 350 
♦  0136  0 

FCLOl 370 
FCLOI 360 
FCLOl 390 


FCLOI 400 
FCL0141 0 
FCL  01 420 
FCLOI 430 
FCL 01 440 
FCLOI 450 
FCLOI 460 
FCL 01 470 
FCLOI 480 
FCL01 490 
FCLOI 500 
FCLO 1510 
FCLOI 520 
FCLOI 530 
FCLOI 540 
FCLO' 550 
FCLOI 560 
FCLOI 570 
fCL01 530 
FCLOI 590 
FCLOibOO 
FCL0161 0 
FCLOI 620 
FCL  01 630 
FCLOI 640 
FCL 01 650 
FCLOi 660 
FCL01670 
FCLOI 660 
FCLOI 690 
FCLOI 700 
FCLO 
FCL0172 
FCLOI 730 
FCL01740 
FCLOI 750 
FCLOI 760 
FCLOI 770 
FCLOI 760 
FCL01790 
FCLOI 800 
FCL0181 0 
FCLOI 620 
FCL01830 
FCL01840 
FCL01850 
FCL 01 660 
FCL01870 
FCLOI 660 
FCL 01 890 
FCLOI 900 
FCLOI 91 0 
FCL 01 920 
FCL 01 930 
FCLOI 940 
FCL 01 950 
FCLOI 960 
FCL01970 
FCL 01 980 
FCL01990 
FCL02000 
FCL0201 0 
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ooooooo  ooo 


IF  (R2.GT. . 001 >  ETh=R2 

KrtPPA=R3 

IJu=k4 

TMPC=R5 

GO  TO  360 

346  TAUBAR=R1 
TMPA=R2 
GO  TO  360 

347  RrtO=RI 
LB0=R2 

GO  TO  360 

348  THETP0=Rt 
PHI 0=R2 
GO  TO  360 

343  LD=IFIXt:R1  ) 

GO  TO  360 

355  ulRITE<  I00UT,357) 

357  FORMftT<  1HO,20X.46H***FCLOUD  ERROR**-*  INPUT  RECORD  DETECTED  WHICH^ 
•V  44HD0ES  NOT  CORRESPOND  TO  CORRECT  INPUT  FORMAT,/) 

GO  TO  360 

338  WRITE< lOOUT, 359 ) 

359  FORt1RT<  1H0,35X,45H'*>*>*FCLOUD  ERROR-*-*-*  TOO  MANY  INPUT  CARDS  OR  GO, 

+  16H  SENTINEL  ABSENT,/) 

1ERR=1 
GO  TO  200 

360  CONTINUE 

361  CONTINUE 
ISW-IFLG+IFLO 
IF<ISW.EQ.3>  ISW=2 

IF<  IGEOSUl.NE.  1  )  GO  TO  222 
XC=PTS< 13) 

YC*PTS<;  14  > 

2C=PTS< 15) 

XR=PTS<4) 

YR=PTS<5) 

2R=PTS<6 ) 

XS=PTS< 1 > 

YS=PTS<  2 ) 

2S=PTS<3) 

222  CONTINUE 

ECHO  INPUT 

WRITE< lOOUT, 1000)  XC , YC , ZC, AE, BE, CE, XR, VR, 2R, XS , YS , ZS 
IF  <ETA.LT.1 .E-20)  CALL  PFNN< LAMBDA, 0 ., INDEXP , PFN , ETA ) 

WRITE< lOOUT, 1100)  INDEXP , ETA, LAMBDA, KAPPA, WO, TAUBAR, THETAO, PHI  0 , 

1 RHO , LB  0 , TMPA , TMPC , LD 
IF<ISW,EQ,2)  GO  TO  15 

ISW  .HE.  2  INDICATES  PRELIMINARY  GEOMETRICAL  CALCULATIONS  TO 
BE  PERFORMED:  COMPUTE  INTERSECTIONS  <XM,YM,2M)  AND  <XN,YN,2N)  OF 
LINE  OF  SIGHT  WITH  CLOUD,  SBAR  =  LENGTH  OF  PATH  FROM  SOURCE  TO 
RECEIVER,  S  “  LENGTH  OF  PATH  IN  CLOUD,  AND  TRANS  =  TRANSMITTANCE 
THROUGH  CLOUD 

L=XS-XR 

M-=YS-YR 

N=ZS-ZR 

SBAR=3(5RT<  L-*L+M-*M4N*N  ) 

L-L/SBAR 

M=M/SBAR 

N-N/SBAR 

D,X=XS-XC 

DY-YS-YC 

DZ-ZS-2C 

ASC-AE'*AE 

B3Q=eE-*BE 

CSO=CE-*CE 

ABSG-ASC>*BSO 

ACSQ°ASQ>*CSQ 


FCL02u2u 
FCL02030 
FCL0204U 
FCL02050 
FCL0206U 
FCL02070 
FCL02080 
FCL02090 
FCL021 00 
FCL021 1 0 
FCL021 20 
FCL02130 
FCL02140 
FCL02150 
FCL021 60 
FCL02170 
FCL02180 
FCL02190 
FCL02200 
FCL0221 0 
FCL02220 
FCL02230 
FCL02240 
FCL02250 
FCL02260 
FCL02270 
FCL022S0 
FCL02290 
FCL02300 
FCL0231 0 
FCL 02320 
FCL02330 
FCL02340 
FCL02350 
FCL 02360 
FCL02370 
FCL02380 
FCL 02390 
FCL02400 
FCL0241 0 
FCL02420 
FCL02430 
FCL02440 
FCL02450 

FCL02460 
FCL02470 
FCL02480 
FCL 02490 
FCL02500 
FCL0251 0 
FCL 02520 
FCL02530 
FCL02540 
FCL02550 
FCL02560 
FCL02570 
FCL 02580 
FCL02590 
FCL02600 
FCL0261 0 
FCL02620 
FCL02630 
FCL02640 
FCL02650 
FCL02660 
FCL02670 
FCL 02680 
FCL026S0 
FCL02700 
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ooooooo  oooon  ooooooo  ooo 


BCS(3=BSGi’i‘CSLj 

h6CSQ*ASGi*BSQ*CSQ 

H=BCSu^L*L+HCSu*i'rt+h(  +  HSSGi+H*N 

B=2 . 0*<  L*0X*BCSQ+M-*'[)Y*ACSQ+N*D2*fteSQ  > 

C=BC  SQ+OXfG'X  +  ACSufDyfOV+HBSO^OZfDZ-HBCSQ 

DI  SCRI1=e‘t'B-4 . 0*A>*C 

IF<  £)  ISCRM  .  GE  .  0  .  u  >  GO  TO  10 

WRITE< lOOUTj 1200) 

S=0  ,  0 
TRANS=1 , 0 
LP=U  ,  0 
GiO  TO  so 

10  SRTl>SC=SORT<  DISCRM  > 

TU0A=2 . 

VPLUS=<  -B-t-SRTuSC  >ZTU0p 
VMIHLIS=<  -B-SRTDSO/TUOA 
xH=XS  +  VPLUS’fL 
YM=VS+VPLUS*H 
2n=2S+VPLUS>t>H 
XH  =  XS  +  VM  I  hiUS  +  L 
Yi'i=YS+Vrl  Il'iUS’HM 
ZH  =  2S  +  VMINIJS*N 

S=SQRT<  <  Xn-XH  )*(  XM-XN  )+(  YM-YN  )*<  YM-YN  )*(  2M-2M  >♦<:  ZM-ZX  >  ) 

It- 1:  S  ,  LT  .  1  .  E-4  >  S^O  .  0 
15  TRhNS==EXP< -kHPpR  +  S  > 

IF<TMPA,LT,-9'9, 0)  GO  TO  20 

TMPh  >=  -99.0  SPECIFIES  THERMAL  CALCULATION 

ReAR=<  AE  +  BE+CE  >X3 . 0 

CALL  THRMCL(  RBAR  JtlO.  TMPA,  TMPC,  LAMBDA,  KAPPA,  TRANS ,  LP  > 

GO  TO  90 

ISW  .HE,  1  SPECIFIES  NEW  PARAMETERS  IN  COMMON  /OPT/i 
ASSOCIATED  PRELIMINARY  COMPUTATIONS  YIELD  EXTRATERRESTRIAL 
IRRADIANCE  EO,  COORDINATES  <L0,M0, NO >  OF  UNIT  VECTOR 
POINTING  TO  SUN,  AND  TATM  =  TRANSMITTANCE  OF  ATMOSPHERE 
ABOVE  CLOUD 

20  IF< ISW.EQ, 1  >  GO  TO  30 
CALL  I LLUr1<  LAMBDA,  LD,E0> 

THT0=THETA0X57 . 2958 
PH0=PHI 0X57. 2958 
L0=SIN<  THTO  )'t<COS<PH0  ) 

M0=SIN<  THT 0  ;»SIN<PH0  > 

N0  =  COS<  THT 0  > 

TATM=EXP<  -TALIBARXNO  ) 

30  WRITE< lOOUT, 1600 >  L , M , N, L 0 , MO , NO 
IF< INOEXP . GT . -1  >  GO  TO  40 

INDEXP  <  0  SPECIFIES  MULTIPLE  SCATTERING  COMPUTATION; 

COMPUTE  TAU  AND  TAUO  =  CLOUD  OPTICAL  DEPTH  AND  THICKNESS, 

AND  CALL  MSCLD  FOR  VALUE  OF  LP  =  PATH  RADIANCE 

XG=<;  XM+XN)X2. 0 
YG=<  YM+YN;jX2. 0 
2G-<  2M  +  ZN  :>/2 . 0 

H=CEfSQRT<:  1  .  0-<  XG-XC  >»<  XG-XC  >/<  AEfAE  YG- YC  >*<  YG-YC  >X<  BE>*BE  >  ) 

TAU0=2.  O’t'H’fKAPPA 

H=ZC-ZG+H 

TAUaKAPPA’fH 

CALL  MSCLD<  TAU, TAUO , TRANS, TATM, EO, WO, ETA, RHO, LP  > 

GO  TO  90 

INDEXP  >  -1  SPECIFIES  SINGLE  SCATTERING  COMPUTATION; 

COMPUTE  SCATTERING  ANGLE  CHI, PHASE  FUNCTION  VALUE  P  “ 

PFN< LAMBDA, CHI  ),  GEOMETRICAL  PARAMETERS  ALPHA,  BETA,  GAMMA, 

DELTA,  AND  EPS,  RGRND  =  GROUND  RADIANCE,  AND  CALL  SSCLD 
TO  COMPUTE  PATH  RADIANCE 


FCL027 1 0 
FCL 02720 
FCLU2730 
FCL 02740 
FCL027t)0 
FCL C2 760 
FCLu277  0 
FCL02760 
FCL02790 
FCL02800 
FCL0281 u 
FCL02620 
FCL 02830 
FCL  0284  It 
FCL  0285  0 
FCL  0286 II 
FCL  028 .'  0 
FCL  0288  0 
FCL 02890 
FCL0290I.I 
FCL0291 0 
FCL  0292  0 
FCL029.S0 
FCL  0294  0 
FCLu295u 
FCL 02960 
FCLu297  0 
FCL 02990 
FCLCi2990 
FCL 030 00 
FCL 03 01 0 
FCL03020 
FCL  0303  0 
FCL 03 040 
FCLOSOSO 
FCL03060 
FCL03070 
FCL03080 
FCL05090 
FCL 031 00 
FCL05 1 1 0 
FCL03120 
FCL031 30 
FCL03140 
FCL 031 sO 
FCL03I60 
FCL03170 
FCL 03 180 
FCL03190 
FCL03200 
FCL 0321 0 
FCL 03220 
FCL03230 
FCL 03240 
FCL03250 
FCL 03260 
FCL 03270 
FCL03280 
FCL03290 
FCL 033 00 
FCL0331 0 
FCL 03320 
FCL03330 
FCL03340 
FCL03350 
FCL 03360 
FCL03370 
FCL03380 
FCL03390 
FCL03400 
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40  THETA=  hCOS<N; 

PHI=0 . 0 

IF<M.NE.  0  ,  0  ,OR  .  L  ,HE  .  0  ,  0)  PHI=|!tTAN2<  M,  L  > 
COSCHI=N*NO+SIN<THETA)*S1N<THTO>*COS<PHI-PHO> 

CHI=  PCOS<  CuSCHI  J’fS?  .  2958 

CALL  PFNN< LAMBDA. CHI , I NDEXP . PPM , ETA > 

P=PFN 

RGRND=E0*TATM*N0 

IFCLBO.LT. 1 .E-1 0)  LBO=RHO*RGRND 

DX=XM-XC 

DV=YM-YC 

DZ=2M-ZC 

LOb^LOfLO 

MOS=MO*MO 

NOS=NO*NO 

LOM=LO*M-MO*L 

LOK=Lu*N-NO*L 

NOM=NO>i>M-MO*N 

rtXLY=MO’»DX-LO>fDY 

NXL2=N0*DX-L  0*02 

M2NV=MO*02-nO-*DY 

DENnM=BCSQ*LOS+ACSQ*MOS+ABSQ*NOS 

ALPHA=<  BCSQ*L>*LCi+ACbQ-«M*M0+A6SG'*N’»No  j/DEHOM 

BETH  =  -<BCSQ*LO*DX  +  ACSu*MO*DY+AeSCil>»NO*DZ>.-'DENOM 

GAMMA=-ABCSa‘*<;  CSQ*L  OM-*L  OH+BSfi^L  ON^t-L ON+ASO*NOM*NOM  )X<  DEHOM'fDENOM  > 
DELTA=CSQi'MXLY*»LOM  +  BSQ*NXLZ*LON+ASQ>*M2NY>»NOM 
DELTA=-2 . 0*ABC  SQ*DELTA/'<  DENOM*DENOM  ) 

EPS=BCSQ*L0S+ACSQ>*M0S+ABSQ*N0S-CSQ*MXLY*MXLY-BSQ^NXL2fNXL2 
l-ASGt-MZNY^MZNY 
EPS=ABCSQ*EPSX<OENOM*OEHOM  ) 

IF<EPS.GE. 0. 0>  GO  TO  50 
WRITE< lOOUT. 1300)  EPS 
EPS»0. 0 

50  IF< GAMMA. LT, 0. 0)  GO  TO  60 
URITE< lOOUT, 1400)  GAMMA 
GO  TO  200 

60  CALL  SSCLD< ALPHA. BETA, GAMMA. DELTA. EPS, S. KAPPA.  klO.RGRND.P.LP) 

C 

C  WRITE  RESULTS 
C 

90  F=LPX<LBO*TRANS) 

TC=t  . OX< 1  . 0+F  ) 

WRITE< lOOUT.  1500)  S.  TRANS, LP. TC 
200  RETURN 

1000  FORMAT< 1H0.43X,45H—  RADIATIVE  TRANSFER  THROUGH  FINITE  CLOUD  --X 

1  1HO/'43X.  14H<x6,YC,ZC)  »  <  ,  2C  F8 , 4 . 1 H,  ), F8 . 4,  1  2H  >  KILOMETERS^ 

2  45X, 14H<AE,BE,CE)  »  < . 2< F8 . 4 , 1 H .  ), F8 . 4 , 1 H  )/ 

3  45X. 14H<XR.YR,2R)  »  < , 2< F8 . 4 , 1 H ,  ), F8 . 4 , 1 H )/ 

4  45X. 14H<XS,YS,ZS>  =  < , 2< F8 . 4 , 1 H , >, F8 . 4, 1 H ) > 

1100  FORMAT< 1H0.45X,8HINDEXP  = , 1 9 , 1  OX , 8HETA  »,F11.3X 

1  45X.8HLAMBDA  =,F9.3,8H  < MU )  ,2X,9HKAPPA  *  ,1PE10.4,7H  <KM-1)X 

2  45X,8H0MEGA  0* , 0PF9 . 3 . 1  OX . 8HTAUBAR  * , 1 X. 1  PE  1 0 , 4/ 

3  45X,8HTHETAO  = , 0PF9 . 1 , 1  OX . 8HPHI 0  *, FI  1.1,1  OH  C DEGREES >X 

4  45X,8HRH0  * , 0PF9 . 3 . 1  OX , 8HLB 0  »,F11.3,13H  < U/M2-SR-MU )X 

5  45X,8HTMPH  =, F9 . 1 , 8H  < DEG . C ) , 2X, 8HTMPC  =,F11.1/ 

6  45X,8HL0  =»,I9) 

1200  FORMAT<  1HO,44X,43H>»»LINE-OF-SIGHT  MISSES  CLOUD.  S  SET  TO  0.0) 
1300  FORMAT<1H0.44X,4HEPS»,E10.4,24H  LT  0.0.  EPS  SET  TO  0.0) 

1400  FORMAT< 1H0,44X,6HGAMMA»,E1 0.4,29H  GE  0.0.  SKIP  TO  NEXT  CASE.) 
1500  FORMAT< 1H0X1H0,37X, 1 IMPATH  LENGTH , 3X, 1 5HTPANSM ITTANCE  , 

1  13HPATH  RADIANCE, 4X.8HC0NTRAST/ 

2  38X,11H<1N  CLOUD)  ,  1  9X ,  1 2H<  W/'M2-SR-MU  ),  1  5H  TRANSMITTANCEX 

3  36X,4<  15H+ - +)/ 

4  1H0,4  0X.F6.3.7X, 1 PE9 . 3, 5X , 1 PE9 . 3 , 5X, 1 PE9 . 3  ) 

1600  FORMAT< 1H0,45X,28HUNIT  SOURCE  VECTOR  L,  M,  N  = , 3< 1 X , F7 . 4  )X 
1  1H0, 45X,23HS0LAR  VECTOR  LO.MO.NO  ■, 3< IX, F7 .4 )  ) 

END 


FCLo34f  0 
FCL03420 
FCL 03430 
FCL03440 
FCL03450 
FCL 03460 
FCL03470 
FCL 03480 
FCL03490 
FCL 035 00 
FCL0351 0 
FCL 03520 
FCL03530 
FCL03540 
FCL03550 
FCL03560 
FCL03570 
FCL03580 
FCL03590 
FCL 036 00 
FCL 036 1 0 
FCL03620 
FCL03630 
FCL 03640 
FCL 03650 
FCL03660 
FCL03670 
FCL 03680 
FCL 03690 
FCL03700 
FCL0371 0 
FCL03720 
FCL 03730 
FCL03740 
FCL03750 
FCL 03760 
FCL03770 
FCL03780 
FCL03790 
FCL 038 00 
FCL0381 0 
FCL03820 
FCL 03830 
FCL03840 
FCL03850 
FCL03860 
FCL03870 
FCL03880 
FCL03890 
FCL03900 
FCL0391 0 
FCL 03920 
FCL03930 
FCL03940 
FCL03950 
FCL03960 
FCL03970 
FCL03980 
FCL03990 
FCL04000 
FCL0401 0 
FCL 04020 
FCL04030 
FCL04040 
FCL04050 
FCL 04 060 
FCL04070 
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000000000000001 


SUBROUTINE  THRMCL<  RBAR , UO , THPh , TMPC , LAMBDA, KhPPA, TkhNS , LP  > 
REAL  LAMBDA  LP  LI  KAPPA 

COMMON  /lOUNIT/IOIN, lOOUT, IPHFUN , LOUNI T , ND IRTU , NCL I MT , KSTOR , 
BB<X,T>=1  .  191  06E8/'<X*>*5*<EXP<  1  .  4388E4/<  X*T  )  >- 1  .  0)) 

Q  %  «  «  >)■  4i  *  4i  <ti  4>  ^  *  4<  «•  >k  I*  4i  %  >f  *  4iDi «  %  Ik  4i  Ki  4i  m  4  %  *  4>  4>  Ik  X<  *  4<  *  4i  *  i«i  41  *  %  «  4  4<  «  «  «  He  *  Kiiti  ,«<  •»  *  »•  I* 

SUBROUTINE  PERFORMS  THERMAL  RADIATION  CALCULATIONS  FOR  FINITE 
CLOUD,  RETURNING  THE  VALUE  OF  LP  =  PATH  RADIANCE. 

INPUTS  ARE: 

RBAR  =  AVERAGE  HALF-LENGTH  OF  PATH  THROUGH  CLOUD 

WO  *  SINGLE  SCATTERING  ALBEDO 

TMPA  «  TEMPERATURE  OF  THt  ATMOSPHERE 

TMPC  =  TEMPERATURE  OF  THE  CLOUD 

LAMBDA  =  WAVELENGTH 

kappa  =  VOLUME  EXTINCTION  COEFFICIENT 
TRANS  =  TRANSMITTANCE  THROUGH  CLOUD. 

:4i  in  >fe  4(  %  9f<  >|(  4(  ^  ^  >li  %  ♦  in  %  « :4c lit  3(1  IK  lime  ^  ^  iK  )«(%%  % 

G=1  . 0-EXP< -KAPPA*RBAR  > 

B=6B<  LAMBDA, 2?3 . 1 b+TMPC  > 

LI»BB< LAMBDA, 273, 16+TMPA) 

UR1TE<  lOOLlT,  i  000  )  B,LI 

LP=<  1  ■  0-TRANS  )♦<<  1  .  0-W0)*<  1  .  O+G^WO  )'*B  +  UO*<  1  .  0-G>fLI  ) 

1  000  FORMATS  1  HO,  43)!,  40H  ♦’^THERMAL  CALCULATION  OF  PAiH  RADIANCEX, 
122H  BBC  LAMBDA, TMPC)  =  ,1PE10.4,11H  W/M2-SR-MU,^  45X , 

122H  BBC  LAMBDA, TMPA)  =  ,1PE10.4,11H  UXM2-SR-MU ) 

RETURN 

END 


THROOOt  0 
THR00020 
NPLOTUTHR00030 
THR00040 
Ik  Ik  Ik  Hi*  ikT  HR  0  0  05  0 
THR00060 
THR00070 
THROOOBO 
THR00090 
THROOl 00 
THR001  1  0 
THRO0i2O 
THROOl 30 
THROOl 40 
THROOiSO 
THR00160 
THROOl 70 
THROOl SO 
ikik»i*ikikTHROOi  SO 
THRO  02 0  0 
THR0021 0 
THR00220 
THR00230 
THR00240 
45X,  THR00250 

THR00260 
THR00270 
THR00280 
THRO  0290 
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o  r.'O  on  o  r  •  o  o  cm 


SUBROUTINE  SSCLD<  NLPHf^,  BETA,  GNMHA,  DELTA,  EPS.  S.  KAPRA^  SSC0001  0 
1W0,RGRND,P,LP)  SSC00020 
COMMON  /lOUNIT/IOIN, lOOUT, 1 PHFUN , LOUNI T , ND IRTU , NCL IMT , KSTOR , NPLOTUSSCO 0030 


SUBROUTINE  COMPUTES  PATH  RADIANCE  LP  FOR  THE  CASE  OF  SINGLE 
SCATTERING  IN  A  FINITE  CLOUD.  INPUTS  ARE  GEOMETRICAL  PARAMETERS 
ALPHA,  BETA,  GAMMA,  DELTA,  AND  EPS,  S  ■»  LENGTH  OF  OPTICAL  PATH 
THROUGH  CLOUD,  AND! 

kappa  =  VOLUME  EXTINCTION  COEFFICIENT 
UO  =  SINGLE  SCATTERING  ALBEDO 
RGRND  =>  SURFACE  BACKGROUND  RADIANCE 
P  =  SINGLE  SCATTERING  PHASE  FUNCTION. 


3SC00050 
SSC00060 
3SC00070 
SSC00080 
SSC00090 
SSC001 00 
33C001 «  0 
SSC00120 


SSC00130 


SSC00140 


REAL  KAPPA  LP 

COMMON  .-’C0NST7PI  ,PI2,PIRAD,TU0PI  ,TORRMB,CDEGK 
ASIN<ARG)=ATAN2<ARG,SQRT<  1  .-ARG»>t‘2>) 

URITE< lOOUT, 1500) 

DISCRM=DELTA*DELTA-4 . 0t.GAMMA*EPS 
IF< DISCRM . GT  ,  0 . 0 )  GO  TO  10 
URITE< lOOUT, 1 000)  DISCRM 
LP=0. 0 
GO  TO  20 

10  TGSDEL=2 .  O’t'GAMMAoS+DELTA 

HS-  AS  1H<  TGSDEL/’S£IRT<  DISCRM  )  >/'SQRT<  -GAMMA  > 

H0=  ASINC  DELTA/’3uRT(  DISCRM  )  >/3QRT<  -GAMMA  ) 

TRANS>»EXP<  -KAPPA*S  ) 

BETA6=u)0’*'kAPPA 

LP-<  1  .  0-BETA*KAPPA  ><»S*<  1  .  0-ALPHA  >*KAPPA*S<'S/^2 . 0 
LP=LP-KAPPA'«'DISCRM*<  HS-HO  )/"<  8 . 0*CAMMA  ) 

LP-LP-KAPPA-K  TGSOEL*SeRT<GAMMA*S*S+DELTA*S+EPS  >- 
1  DELTA*SQRT<  EPS  )  >A  4 . 0>*GAMMA  ) 
LP-BETAB*LPn>P*RGRND*TRANS7<  4 . 0*PI  > 

20  RETURN 

1  000  FORMATOHODISCRM  »,E10.4,25H  IN  SSCLD.  LP  SET  TO  0.0> 
1500  FORMAT< 1H0,43X,33H  »*RESULTS  FOR  SINGLE  SCATTERING) 
END 


SSCOOl 60 
SSC00170 


SSC00180 
SSC00190 
S3C00200 
SSC0021 0 
SSC00220 
SSC 00230 
SSC00240 
SSC00250 
SSC00260 
SSCO  0270 
S3C00280 
SSC00290 
SSC00300 
8SC0031 0 
3SC00320 
SSC00330 
SSC00340 
SSC00350 
SSC00360 
SSC00370 
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c 

c 

c 

c 
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SUBROUTINE  PPNN<  LAMBD<^,  CHI ,  INDEXP,  PFH,  ET«  > 

REAL  LAMBDA, LAMDAl ,LAMI ,LAM2. KAPPA 

COMMON  XIOUNIT/IOIH, lOOUT, IPHFUN, LOUNIT , NDI RTU , NCL I MT , KSTOR , 
COMMON  XCONST/PI , PI2, PIRAD, TWOPI , TORRMB, CDEGK 
DIMENSION  PHANG<65>,PF1<  65 ),PF2<65> 

DATA  LAMDA1 , IP1 ,CH11X-1 . 0,-2,-1 . 0/ 

4  I*  Xc « :ti  41 «  Hr  A  :)> « i|>  ;ti  lit  4i  If  4i  4>  Ik  *  4<  4' ^  <l<  »<  *  ifc  1<  i4<  %  « *  >l<  %  *  4<  Ki  %  *  %  «<  >4< 

SUBROUTINE  COMPUTES  THE  VALUE  OF  THE  INOEKP-TH  PHASE  FUNCTION 
AT  SCATTERING  ANGLE  CHI  AND  WAVELENGTH  LAMBDA  USING  BILINEAR 
INTERPOLATION. 

4i  4i  4i  4i  4< '4<  4i  4i  4c  4t  4t  4i  4i  4i  4i  4i  4i  4i  41 4i  4i  4i  4<  4>  4i  4t  41 4<  4t  4<  4i  4<  4i  41  >*  4t  41 4t  41 4i  4>  41 4i  4>  4i  4i  4t  4<  4i  4t  4i  4i  4<  4i  4t  4>  4<  4i  4t  4t  4i  4t  4i  4t 

ACOSC  ARG  .>=ATAN2<  SORT<  1  , -ARG4.4-2  >,  ARG  > 

IERR=0 
MAX I D= 12 

PFNDAT  ONLY  CONTAINS  ONE  PFN  FOR  THE  VISIBLE  <.55UM>  AND 
THE  NEAR  IR  < 1  . 06UM ; !  THEREFORE  DO  NOT  INTERPOLATE. 

IuiAVE=0 

2. 0>  IWAVE=1 
FOR  FINDING  ETA 


PFN0001 0 
PFN00020 
NPLOTUPFN00030 
PFN00040 
PFN00050 
PFN00060 
4i4i4c4c4c4cPFN00070 
PFN00080 
PFN00090 
PFN001 00 
PFN001 1 0 
PFN  0012  0 
4t4t4i4<4t4cpFN00i3  0 

PFHOOt40 


IDCk=1 

INDE.XP=-INDEXP 
.AND. CHI .EG.CH11 .AND. 


LAMBDA . EQ . LAMDA 1  ) 


IF  < LAMBDA. LT. 

C  PRELIrilNARIES 
ETA1*0.0 
E 1 A2=u . 0 
I  DCK  =  0 

IF  <  1NDEXP.lt. Oi 
IF  <  INOEXP.lt. 0> 

IF< INDEXP.EO. IP1 
1GO  TO  200 

IF<  IHDEXP  .  EQ  .  IP1  .  AND  .  LAMBDA  ,  EQ  .  LAilDAl  >  GO  TO  70 
REWIND  IPHFUN 
NRD  =  0 

DO  20  1=1,66,11 

PEAD<  IPHFUN,  1  000  >  <PHANG<  I  +  J-1  >,  J=«1 ,  1 1  ) 

DO  10  J=1 , 1 1 
NRD=NRD+1 

IF<PHAHG<NRD).GE. 999.9)  GO  TO  30 
1 0  CONTINUE 
20  CONTINUE 
30  HA=NRD-1 

DO  35  1=1, NA 

35  PHANG< I  )=COS<PHANG< I )*PIRAD) 

40  CONTINUE 

C  END-OF-FILE  CHECK 

IF  < lERR ,EQ,2>  GO  TO  195 

READ< IPHFUN, 1100)  IANG1 , ID,LAM1 , WO, KAPPA, BETA 
IF  <LAM1 .GE. 12. OO.AND. ID.EC.MAXID)  1ERR=2 
READ< IPHFUN, 1200)  <PF1< 1 >, 1=1 ,NA) 

SUM=0 . 

C  START  RENORMALIZATION  OF  PHASE  FUNCTION  -  ALSO  SEE  BELOW 

DO  45  J=2,NA 

45  SUM=SUM+<-PHANG<  J  )+PHANG<  J-1  ))4.<PFU  J)+PF1<  0-1  )>/4. 

DO  46  J= 1 , NA 

46  PF1<  J>»PF1<  J>/'SUM 
ETA1=ETAINT<PF1 ,PHANG,NA) 

IF< ID.NE. INDEXP)  GO  TO  40 

IF  < IWAVE.EQ, 1 , AND, LAMBDA, GT.LAMl )  GO  TO  40 
IF  < IWAVE.EQ. 1)  GO  TO  75 

I F< L AMBDA.lt. LAM  1  )  GO  TO  190 

50  CONTINUE 

IF  < IERR.EQ.2>  GO  TO  195 

READ( IPHFUN, 1100)  IANG2, ID,LAM2,W0,KAPPA,BETA 
IF  <LAM2.GE. 12. .AND. ID.EQ.MAXID)  IERR-2 
READ< IPHFUN, 1200)  <PF2< I >, 1=1 ,NA> 

SUM=0. 

DO  55  J=2,NA 

55  SUM»SUM+<  -PHANG<  J  )4.pHANG<  J- 1  )  )■►<  PF2<  J  )+PF2<  J- 1  >  )/4  . 

DO  56  0=1, NA 

56  PF2< 0)-PF2< 0>/SUM 
ETA2-ETAINT<  PF2, PHANG,  NA ) 

C  THE  PHASE  FUNCTIONCS)  ARE  NOW  NORMALIZED  TOi  INTEGRAL  OF 


PFN00150 
PFN00t60 
PFN001 70 
PFNOOiaO 
PFN00190 
PFN00200 
PFN0021 0 
PFN00220 
PFN00230 
PFN 00240 
PFN00250 
PFN 00260 
PFN 00270 
PFN 00280 
PFN00290 
PFN 003 00 
PFN0031 0 
PFH00320 
PFN  0  033  Cl 
PFN00340 
PFN00350 
PFN00360 
PFN00370 
PFN00380 
PFN00390 
PFN 004 00 
PFN0041 0 

PFN00420 


PFN00430 
PFN00440 
PFN00450 
PFN00460 
PFN00470 
PFN00480 
PFN00490 
PFH00500 
PFN0051 0 
PFN00520 
PFN00530 

PFN00540 
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PHASE  FUNCTION  OVER  ALL  SOLID  ANGLE  DIVIDED  BV  4  PI  =  1 , 
IF<1D.NE.INDEXP)  GO  TO  190 
I F< LAMBDA . LE . LAM2 i  GO  TO  70 
LAM1=LAM2 
IANG1 "IANG2 
DO  60  1=1, NA 
PF1< I >=PF2< I > 
j  CONTINUE 
GO  TO  50 
CONTINUE 

IF  t  lUAVE  .  EQ  .  1  >  GO  TO  75 
DLAM=< LAMBDA-LAM  1  >/<LAM2-LAH1 > 

CONT INUt 

IF<CHI .LT.-1 .E-3.0R.CHI .GT. 180. 001 >  GO  TO  190 
DO  S  0  J=2 , NA 

IF<CHI  .LE.<AC0S<:PHANG<  J))/PIRAD)>  GO  TO  90 
D  CONTINUE 
J=HA 
j  J1=J-1 

DCHI=<C0S<CHI*PIRAD:>-PHANG<  J1  ))/’<PHANG<  Ji-PHANG-:  >> 

IF  <IWAVE.NE,1>  GO  TO  95 
PFN=PF1<  J1  >+DCHI*<PF1<  J)-PF1<  J1  )) 

GO  TO  96 

PFN=PF1<  J1  )+DLAM*<PF2<  J1 >-PF1<  J1  ) )+DCHI*< PFl <  J >-PF1 <  J1  >: 
1 +DLAM*DCH1*< PF2<  J)+PF1<  J1  )-PF2<  VI  )-PF1<  V>> 

LAMDA1=LAMBDA 
CHI  1 =CHI 

IF  <IP1,NE.-2)  WRITE< lOOUT, 1500)  CHI,PFN 
IP1=1NDEXP 

ETA=ETA1+DLAM*<ETA2-ETA1  ) 

GO  TO  200 

)  WRITE< lOOUT, 1300)  ID, INDEXP.LAMI , LAMBDA, CHI 
STOP 

WRITE  <IOOUT,1600)  IPHFUN 
STOP 

CONTINUE 

IF  <IDCK.EQ.1)  INDEXP«-INDEXP 
RETURN 

i)  FORMAT<  1  1<F6.2,  1X)> 

)  F0RMAT<:2<  12,  1X),F5.2,  1X,F8.6,  1X,2<E12.6,  1X>> 

)  F0RMAT<6<E12.6, IX)) 

)  FORMAT<33HOERROR  IN  READING  PHASE  FUNCTION./ 

127H  ID, INDEXP,LAM1 ,LAMBDA,CHI=,2I3,3Et3.7) 

)  FORMAT< 1H0,23HSCATTERING  ANGLE  CHI  ■  ,F8.2,7X,24H  PHASE 
+  A,CHI  :)=,E1  0.4) 

FORMAT< 1X,32HATTEMPT  TO  READ  PAST  EOF  ON  UNIT,I3.18H  IN 
1  PFN//) 

END 


PFN00550 
PFN00560 
PFN00570 
PFN00580 
PFN0059U 
PFN00600 
PFN0061 0 
PFN 00620 
PFN00630 

PFN00640 

PFN 00650 
PFN00670 
PFN00680 
PFN00690 
PFN 007 00 
PFN 0071 0 
PFN00720 


PFN00730 
PFN 00740 
PFN00760 
PFN00770 


PFN00790 
PFN00800 
PFN0081 0 
PFN00820 
PFN00830 


PFN00840 
PFN00850 
PFN00860 
PFN00870 
PFN00880 
PFN0089U 
FN  PtLAMBDPFN00900 
PFN0091 0 
SUBROUT INEPFN 00920 
PFN00930 
PFN 00940 
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Cl  o  r  1  o  r  I  o  r  1  o  o  o  r>  o  n  o  i 


SUBROUTINE  MSCLD<  ThU , ThU 0, TRANS, TATM, EO, Uu, ETA, RHO , LP  >  MSCu 

REAL  LP,LBAR,K  MSCO 

COMMON  /’C0NST/P1,PI2,PIRAD,TW0PI,T0RRMB,CDEGK  MSCO 

COMMON  /lOUHIT/IOIN, lOOUT, IPHFUN, LOUNI T, NDI RTU, NCL IMT , KSTOR , NPLOTUMSC 0 
S I NH<  ARC  >= . 5*<  EXP<  ARC  >-EXP< -ARC  > ) 

COSH<  ARC  >=  .  5’f<  EXP<  ARG  >+EXP<  -ARC  >  > 

C**  **  I'’*'******’****** * +  *  +  *+’*'****‘l'H<>*>J«i|<**J*ii»i<>>tt***i(<»**********!)t*:*i*J|iHi*:#i*i**i4ii*i*.*ciHMSC  C 

MSCO 

SUBROUTINE  COMPUTES  LP  =  PATH  RADIANCE  DUE  TO  MULTIPLE  SCATTERING 
IN  A  FINITE  CLOUD.  INPUTS  ARE: 


0010 

0020 

0030 

0040 


TALI  =  CLOUD  OPTICAL  DEPTH 
TAUO  =  CLOUD  OPTICAL  THICKNESS 
TRANS  =  TRANSMITTANCE  ALONG  LINE  OF 
lATM  =  TRANSMITTANCE  OF  ATMMOSPHERE 
EO  =  EXTRATERRESTRIhL  IRRADIANCE 
uiO  =  SINGLE  SCAiTERING  ALBEDO 
ETA  =  FORWARD  SCATTERING  PARAMETER 
RHO  =  BACKGROUND  SURFACt  RtFLEClANCt 


MSl  0 
MSCO 
MSCO 
MSCO 
MSCO 

SIGHT  MSCO 

ABOvt  CLOUD  MsCO 

MSCO 
MSCO 
MSCO 
MSCO 
MSCO 

IFLWO.LT.  1  , Oi  GO  TO  10 
W0= , 999 

UR  I  TEL IOOUT,2  0  00) 

10  Cl  =  1  .  0-ETA‘fWO 
C2  =  <  I  ,  0-ETA  )*i)0 
K=SQRT<  (  1  .  O-WO  >>t<<  1 
T0K=K*TAU0 
T uTK^Kfc  TAUO-TAU  > 

TK2=2. 0*K>*‘TAU 

GAMMA=E0*TATMM<  Cl f SIHH<  T OK )+K*COSH<  T OK  >  > 

DELTA=RHO*KM<<C1 -RH0*C2  >kSINH<2 . 0*T0K >+K*COSH<  2 , 0*T0K  >> 

WRITEL lOOUT, 1 000  > 

EPLUS*C2t<SINH<  TOTK  )  +  DELTA>*.<  C 1  fS I NH<  TK2  >+K*COSH<  TK2  )  > 

EMINIJS=C1  >*:31NH<  TOTK  >+K*COSH(  T  OTK  >+DELTA*C2kSINHC  TK2  > 

LBAR=GAMMA>:<<  F.PLUS+EMINUS  )MTW0PI 
LP=WO>fLBAR*L  1  .  0-TRANS> 

WRITEL lOOUT, 1 00>TAU, TAUO, TATM 
100  FORMATL 1H0,45X, 13H  OPTICAL  DEPTH  =  , 1  PEI  0 . 4/ , 45X, 

131H  OPTICAL  THICKNESS  OF  CLOUD  *  , t PE  1 0 , 4M , 45X , 

244H  TRANSMITTANCE  OF  ATMOSPHERE  ABOVE  CLOUD  =  ,1PE10.4> 

RETURN 

♦  '•■RESULTS  FOR  MULTIPLE  SCATTERING  ) 

’♦■♦OMEGA  0  WAS  1.0,  NOW  SET  TO  0,999  IN  MSCLD  > 


O  +  WO-2  ,  O^ETA-»WO  >  > 


1000  FORMAT<3bHO 
2000  FuRMAT<47H0 
END 


MSCO 

MSCO 

MSCO 

MSCO 

MSCO 

MSCO 

MSCO 

MSCO 

MSCO 

MSCO 

MSCO 

MSCO 

MSCO 

MSCO 

MSCO 

MSCO 

MSCO 

MSCO 

MSCO 

MSCO 

MSCO 

MSCO 

MSCO 

MSCO 


0050 
006  0 
00?  0 
ooso 
0  090 
01  0  0 
0110 
0  1  2  0 
0130 
0 1  4  0 
0150 
0  1  6  0 
017  0 
>5 1  S  0 
019  0 
02  0  0 
021  0 
022  0 
023  0 
0240 
0250 
0260 
0270 
028  0 
0290 
03  0  0 
031  0 
0320 
0330 
034  0 
035  0 
036  0 
0370 
0380 
039  0 
04  0  0 
04  1  0 
042  0 
0430 
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non 


FUMCTION  ETAINT<PFH,PHANG,H(!|> 

THIS  FUNCTION  WILL  DETERMINE  ETA,  THE  FORWARD  SCATTERING 
PARAMETER:  ETA* . 5*1NTEGRAL  PFN  OVER  THETA,  WHERE  THETA  COES 
FROM  2ER0  TO  PI/2, 

COMMON  /CONST/  PI ,  PI2,  PIRAO,  TUOPI ,  TuRRMB,CDEGi<: 

DIMENSION  PHANG<65>,PFN<65) 

NAM1=NA-1 
ETA=0. 

DO  1  1-1,NAM» 

IF<PHANG< 1+1 ).GT. 0. >  ETA=ETA+< PHANG< I >-PHANG< 1+) > >♦ 
i  < PFN< 1+ 1  )+PFN< I >  i/4 . 

1  CONTINUE 

ETAINT=ETA 

RETURN 

END 
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rjrir'Or'Or..oriooi''r.rir’OriririOOorir'r.ioooooi  M"' 0'“-r(0f  '0or""'0r'0r'0ri00 


SUBkuUTINE  DVRCST<  LhHBDh, TRhNS, IEkR ; 

REAL  LC,LG,LBO.KftPPA,LAt^BC'ft.  MU,LP 
DIMENSION  1ALPH<7) 

COMMON  /lOUNIT/iOIN,  IOOi.IT,  I PHFUN ,  LOUNI T  ,  Nf*  I  RTiJ,  NCL  I  NT ,  kSTOR , 
COMMON  7GE0MET,''PTS<  1  5  ) IGEOSU 
DATA  IZERO/0/ 

DA  I A  IALPH/2H0P  ,  Si-ISP  ,2HCt  ,  SHBi';  ,2HGR  ,  2H  i  E  ,  2Hf.O  / 
BBC  X,  T  )=1  ,191  062E8/<  EXPC  !  .  4337864E4/<  X*T  )  .’>-1  ■  0  )  > 

SUBROUTINE  COMPUTES  BEAM  TPAHSMITTANCE,  PATH  RADIANCE,  AND 
CONTRAST  TRANSMITTANCE  ALONG  AN  OPTICAL  PATH  UNDER  AN  OVERCAST 
SKY.  ORDER-INDEPENDENT  INPUT  CARDS  APE  AS  FOLLOWS; 

CINDIVIDUAL  RECORD  FORMAT  IS  c A4 ,  1 X , 5c E 1 0 , 4 , 1 X > > 


MNEMuN  I C 

VARIABLES  READ 

DESCRIPTION 

GPOS 

Xu, VO, 20 

OBSERVER  Pus  IT  ION 

SP03 

XT, YT,2T 

SOURCE  POSITION 

CLOS 

ZC, LC .KAPPA, ETA  ,W0 

CLOUD  PARAMETERS 

BKGR 

LBO 

BACKGROUND  RADIANCE 

bKNU 

LC, 

UKUUND  Kttui  WNL-t 

temp 

TEMP 

TEMPtRATURt  ALONG  PA 

fj'j 

fc.NO  ufc  KtAD  oENTiNtL 

THE  VAP.IABLtS  2C  AND  LC  REFER  TO  THt  OVERCAST  SKV  LAYtR! 

THE  VARIABLES  KaPPA,  ETA,  WO,  TEMP,  REFER  TO  THE  ATMOSPHEftt 
BETUEEH  THE  OVERCAST  SKY  AND  GROUND  I.E.  THE  INTERVENING 
ATMOSPHERIC  PROPERTIES  < GAS  OR  AEROSOL) 

*'*  NOTl  ;  THE  GO  CARD  MUST  St  THE  LAST  RECORD  READ. 

THE  FOLLOWING  ENUMERATES  THE  VARIABLES  LISTED  ON  THE  ABOVE  CARDS 

<X0,Y0,20)  =  OBSERVER  COORDINATES 

<XT,YT,2T)  =  SOURCE  COORDINATES 

2C  =  HEIGHT  OF  Cl.OUD  LAYER 

LC  =  CLOUD  RADIANCE 

LG  =  GROUND  RADIANCE 

lBO  =  BACKGROUND  RADIANCE 

KAPPA  =  VOLUME  E.XTINCTION  COEFFICIENT  (KM-1) 

ETA  =  FORWARD  SCATTERING  PARAMETER 

WO  -  SINGLE  SCATTERIHG  ALBEDO 

TEMP  =  TEMPERATURE  ALONG  PATH  <DEG.  C  .> 

LENGTH  UNITS  ARE  KILOMETERS;  RADIANCE  UNITS  ARE  W,^N2-SR-MU, 

IF  TEMP  >=  -99,,  THERMAL  RADIATION  IS  CALCULATED;  IF  TEMP  <  -99. 
SINGLY  SCATTERED  RADIATION  IS  CALCULATED, 

subroutine  RETURNS; 

tkans  =  seam  transmittance 
TO  CALLING  PROGRAM, 

♦  ^  jif*  %  -f;  *  *  I#*  Hi  >t»  ^  )*:  %  5^  t*'  :f:  If  -tc  ♦  %  ♦  >k  ♦  Jf:  :f.  *  sf  +  ★  *  ♦  %  ♦  ♦ 

data  initialization 

.  NE  .  0  ■)  GO  TO  477 


OVR 

OVR 

OVR 

NPi.OTUOVR 

OVR 

OVR 

OVR 

OVR 

i(.H<*i»<%  +  OVR 

OVP, 
OVR 
OVR 
OVR 
OVR 
OVR 
UVR 
DVR 
OVR 
OVR 
OVR 
OVR 
OVR 
OVR 
0  V  R 

UVK 

OVR 


0  0  01  0 
0  0  020 
00030 
1)  .0  /■)  4  f) 
0  0  050 
0  n  0  n 
0  0  07  0 
0  0  080 
0  0  090 
0  01  0  0 
0  0110 
00120 
0  0  1  3  0 
0  li ;  4  0 

0 11 1  5  0 

0  0  1  fc.  0 

0  'J  1  7  0 
C  0  1  S  0 
0  0  1  S  U 
0  0.7  0  0 
0  02  1  0 
0  022  0 
0  0230 
0  0  2  4  0 
u  0  2 0 

0  026 1'j 


IFC  I 
XO  =  0 
YO=0 
20=0 
XT=0 
YT  =  0 
2T=0 
2C=  0 
LC  =  0 
KAPP 
ETA 
W  0  =  0 
LBO^ 


ZERO  , 
.  0 
.  0 
.  0 
.  0 
.  0 
.  0 
.  0 
.  0 

A  =  0  ,  I 
=  0 , 0 
.  0 
0.  0 


OVR 
0  V  R 
OVR 
OVR 
OVR 
OVR 
OVR 
OVR 
OVR 
OVR 
OVk 
OVR 
OVR 
OVR 
OVR 
OVR 
OVR 
OVR 
OVR 
OVR 
OVR 
OVR 
OVR 

OVR 

OVR 

OVR 

OVR 

OVR 

OVR 

OVR 

OVR 

OVR 

OVR 

OVR 

OVR 

OVR 

OVR 

OVR 

OVR 


U  L'4  !i 

0  02.90 
0  O'  S  9  0 
0Ci3uCi 
0  0310 
0  032  0 
0  033  0 
0  034  0 
0  03 r..O 

0  0  i  6  0 

0  037  0 
0  039  0 
0  039  0 
0  04  0  0 
0  041  0 
0  042  0 
0  043  0 
00440 
0  0450 
0  046  0 
0  04  7  0 
0  0  4  9  0 
0  0490 
0  u  5  0  0 
0  051  0 
0  0520 
OOd.;,  0 
0  054  0 
OO^tiO 
0056  0 
00570 
0  058  0 
0  059  0 
0  06  0  0 
0  061  0 
0  062  0 
0  063  0 
0  0640 
0  065  0 
0  066  0 
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LCi=0 .  0 
TtMP  =  0 , 0 
I2£ft0=) 

477  CONTINUE 

Ou  360  K=1,7 

REND<  JOIN, 334 >I A. Irt2 , R 1 , R2 , R3 , R4 , R5 
334  E0RMATi:2A2, 1X,5<E1  0,4,  IX)) 

DO  333  I=t,8 

IF< IN.HE . IALPH< I  ))  GO  TO  333 
IND=I 

IF< IHD.EQ.?)  GO  TO  361 
333  CONTINUE 

IF< iHD . EO . 8  )  GO  lO  355 
IFnK.EO.T.AND. IND.NE,?)  GO  TO  358 
GO  TO  ■'341 ,342,343,344,345,346),  IND 

341  XO=R1 

yo=P2 
20=R3 
GO  TO  360 

342  XT=h1 
yT=ft2 
2T=R3 

GO  TO  360 

343  2C=Rf 
l.C=P2 
KAPPP=R3 
ET«  =ft4 
W0=R5 

GO  TO  360 

344  LB0=R1 

GO  TO  360 

345  LG=R1 

GO  TO  360 

346  TEMP«R1 
GO  TO  360 

355  WRITE< I00UT,357) 

357  FORMPTt:  1HO,25X,44H*'»kOVRCST  ERROR***  INPUT  CPRO  DETECTED  WHICH, 

+  36H  DOES  NOT  MATCH  CORRECT  INPUT  FORMAT,/) 

GO  TO  360 

353  WRITE< lOOUT, 359) 

359  FORMATC  1H0,34X,45H*fi'OVRCST  ERROR***  TOO  MANY  INPUT  CARDS  OR  GO, 
*  16H  SENTINEL  ABSENT,/) 

IERR=I 
GO  TO  200 

360  CONTINUE 

361  CONTINUE 

IF( IGEOSW.NE , 1  )  GO  TO  222 
X0=PTS<4.> 

Y0=PTS<5> 

20=PTS<6) 

XT=PTS< 1 ) 
yT=PTS<2) 

2T»PTS<3) 

222  CONTINUE 

C  ECHO  INPUT 
C 

WRITE< lOOUT, 1000)  NO, NT, VO, VT. 20, 2T. ZC , LC, LAMBDA . LG , 

1  TEMP, LBO .KAPPA, WO, ETA 
IF<TEMP,LT.-99, 0)  GO  TO  4 
BeTEMP=BB<  LAMBDA, 273 . 16+TEMP  ) 

WRITE< lOOUT, 1800)  BBTEMP 
BTE=<U0-1 . 0)*BBTEMP 
GO  TO  8 

4  WftITE< lOOUT, 1700) 

8  F=2. 0*< 1 . 0-ETA  > 

2LEN^=2T-20 

3=S0RT<  <  XT-XO  >**2*<  VT-YO  )**2+ZLEN**2 ) 

MU-ABS<ZLEN >/S 
TO=KAPPA*ZO 


OVft00670 
OVR00680 
OVR00690 
OVR0070CI 
OVROu7 1 u 
OVRO 
OVR0073 
OVR00740 
OVR00750 
OVR00760 
OVRO 0770 
OVR00780 
OVR00790 
OVRO 08 00 
OVROOS1 0 
OVRO 0820 
OVRO  08.5  0 
OVRO 0840 
UVR00850 
OVRO 0860 
OVRO 08 70 
OVRO 0880 
OvR 00850 
OVRO 05 00 
OVRO 05 1 0 
OVRO 0520 
UVR00530 
OVRO 0940 
OVRO 09 50 
OVR00560 
OVR00970 
OVR00580 
OVR00590 
OVR01 000 
OVROi 01 0 
OVR01 020 
OVROI 030 
OVROI 040 
OVROI 050 
OVROI 060 
OVROI 070 
OVROI 080 
OVROI 090 
OVROI 1 00 
OVROI 1 1 0 
OVROI 120 
OVROI 130 
OVROI 140 
OVROI 150 
OVROI 160 
OVROI 170 
OVROI 180 
OVR0U90 
OVRC1200 
OVR0121 0 
OVR01220 
OVR01230 
OVR01240 
OVR0t250 
OVR0t260 
OVR01270 
OVROI 280 
OVR0t290 
OVR01300 
OVR0131 0 
OVR01320 
OVR01330 
OVRO 1340 
OVR01350 
OVR01360 
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TT=l<;HpPrt*2T 

S0=KPPPP*<2C-Z0> 

S 1  =KhPPP>*<,  ZC-ZT  ) 

TRANS=EXP< -KAPPAfS  > 

CONST=UO*ETA  /2.0 
IF<ZLEN>  10,40,70 

C 

C  HEIGHT  OF  OBSERVER  >  HEIGHT  OF  SOURCE 

^  10  G21=G2<T0,TT,MU) 

G22=G2<S0,ST,-MU> 

T1=EXP<-TO,''MU) 

T2=EXP<S0/'HU> 

FI =W0*F*KAPPAfS*Tl/2 . 0 
XIHT1=C0NST*T1*G21 
XIHT2=C0NST*T2*G22 
IF<TEMP,GE.-SS. 0)  GO  TO  20 
LP=LG*< Ft+XIHTI >+LC*XINT2 
GO  TO  100 

20  LP=';  LG  +  BTE>-*'<F1+XINT1  )+<  LC  +  BTE  >*XINT2*U0>*BTE*<  TRANS- 1  .  0> 
GO  TO  100 

C  HEIGHT  OF  OBSERVER  =  HEIGHT  OF  SOURCE 


40  E21=l . 0 
E22=1 . 0 

IF<TO.NE. 0. 0)  E21»EXP<-T0>-T0*E1<T0) 

I  F<  SO  .  HE  .  0  .  0  >  E22=EXP<  -SO  >-SO'»E  1  <  SO  > 

IF< TEMP . GE . -99 . 0  )  GO  TO  50 
LP=CONST*< 1 . 0-TRANS>*<LG*E21*LC*E22> 

GO  TO  100 

50  LP=CONST‘*<  E2 1  •*<  LG+BTE  )+E22*<  LC+BTE  >  ) 

LP^'^LP-UOfBTEJ-K  1  .  0-TRANS) 

GO  TO  100 
C 

C  HEIGHT  OF  OBSERVER  <  HEIGHT  OF  SOURCE 

70  G21=G2<T0,TT,-MU> 

G22=G2<S0,ST,MU) 

T1*EXP<-S07MU) 

T2=EXP<T0..^MU) 

F1=U0-fFi<KAPPA*S*Tl/’2. 0 
XINT1=C0NST*T2*G21 
XINT2=C0NST*T1*G22 
IF<TEMP.GE.-99. 0)  GO  TO  80 
LP=LCf<Fl+XINT2>+LGt<XINT1 
GO  TO  100 

80  LP-<LC+BTE)*<F1+XINT2>+<LG+BTE>*XINT1+W0*BTE*<TRANS-1 , 0> 
C 

C  WRITE  RESULTS 


100  TC=1  .  0,^<  1  .  0+LP7<LB0*TRANS>) 

URITE< IOOUT,2000)  3, TRANS, LP, TC 
200  RETURN 

1  000  FORMAT<  1H0/’1H0,55X,34H—  RADIATION  UNDER  OVERCAST  SKY  —/ 


»,5X,F6.3,5H  <KI1)7 


1  1HO,43X,8HXO  -,5X,F6.3,5H  < KM ), 8X , 3HXT  »,5X,F6.3,5H  < KM >7 

2  44X,8HY0  - , 5X, F6 . 3 , 1 3X, 5HYT  -,5X,F6.37 

3  44X,8H70  » , 5X , F6 . 3 , 1 3X , 5HZT  -,5X,F6.37 

4  44X,8HLC  =, 5X, F6 . 3, 1 3X, 5HLC  «, 1 X, 1  PEI  0 , 4, 1 3H  C W7M2-SR-MU >7 

5  44X,8HLAMBDA  » , 5X , 0PF6 . 3 , 5H  <MU>,8X,5HLG  » , 1 X , 1  PE  1 0 . 47 

6  44X,8HTEMP  3X, 0PF6 . 1 , 1  OH  <6eG . C >, 5X, 5HLB0  - , 1 X, 1  PEI  0 . 47 

7  44X,8HKAPPA  = , 1 X, E 1 0 . 4 , 7H  < KM- 1 >, 6X, 5HW0  »,5X,0PF6.37 

8  44X,8HETA  =,6X,0PF5.3) 

2000  FORMAT< 1  HO , 39X, 4HPATH, 7X , 1 3HTRAN8MITTANCE, 2X, 13HPATH  RADIANCE, 

1  4X  8HC0NTRAST^ 

2  38X, 1  1HLENGTH  < KM  ) , 1 9X , 1 2H< W7M2-SR-MU >, 1 5H  TRANSMI TTANCE7 

3  36X,4<  15H+ - +)7 

4  1H0,39X,F6,3,9X,F7.5,7X, 1PE9.3.7X, 0PF7 . 5 > 

1700  FORMATS  1H  0,5  OX,  31  H>**R£SULTS  FOR  SINGLE  SCATTERING) 

1800  FORMAT< 1H0,46X,38H**THERMAL  CALCULATION  OF  PATH  RADIANCE7 


1  1H0,43X,8HX 

2  44X,8HY0 

3  44X,8H70 

4  44X,8HLC 

5  44X,8HLAMBD 

6  44X,8HTEMP 

7  44X,8HKAPPA 

8  44X,8HETA 


OVR01370 
OVR013S0 
OVR01390 
OVR01400 
0VRC141 0 
OVR01420 
OVR01430 
OVR01440 
OVR01450 
OVR01460 
OVR01470 
OVR01480 
OVR01490 
OVR01500 
OVR0151 0 
OVR01520 
OvROI 530 
OVR01540 
OVROI 550 
OVR01560 
OVROI 570 
OVR01580 
OVROI 590 
OVR01600 
OVROI 61 0 
OVR01620 
OVR01630 
OVROI 640 
OvROI 650 
OVROI 660 
UVR01670 
OVR01680 
OVR01690 
OVR01700 
OVROI 71 0 
OVROI 720 
OVROI 730 
OVR01740 
OVR01750 
OVR01760 
OVROI r?  0 
OVR01780 
OVR01790 
OVR01S00 
OVR0181 0 
OVR01820 
OVR01830 
OVROI 840 
OVR01850 
OVROI 860 
OVROI 870 
OVROI 880 
OVR01d90 
OVR01900 
OVR0191 0 
OVR01920 
OVR01930 
OVR01940 
OVR01950 
OVROI 960 
OVR01970 
OVR01980 
OVR0199O 
OVR02000 
OVR0201 0 
OVR02020 
OVR02030 
OVR 02040 
OVR02050 
OVR02060 
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r 


f 


1  iH0,50X,8HBBTEMP-  ,1PE10.4,11H  (il/'H2-SR-MU > 
END 


OVR02070 

OVR02080 
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FUNCTION  G2<TAU1 ,TAU2,MU> 

ill  41%  %  >|i  )|i  %  ill  )|t  ift  4iiti  4i  #  4(  %  41 4«  4(  4i  4i«|i  )|i  4i  4t  %  m  4t  i4ii|c  4i  %  4(  %  4i  %  III  it  III  ]f.  %  4ii|t  )|i  %  %  itt  4i 

SUBROUTINE  COMPUTES  IN  CLOSED  FORM  INTEGRALS  OF  THE  FUNCTION 
EXP<  TAU/MU  >h.E2<  TAU  > 

WHERE  E2  IS  THE  SECOND  EXPONENTIAL  INTEGRAL.  FOR  DETAILS  SEE 
KOURGANOFF,  'BASIC  METHODS  IN  TRANSFER  PROBLEMS'.  APPENDIX  I 
<PAGES  256-257  OF  FIRST  EDITION,  1952,  OXFORD  UNIVERSITY  PRESS.) 

Ik  iti  •  4:  *  41  *  4i «  4<  Hi  4i  4i  4. 4>  4<4i  >•>*>)••  W  ««  Kt  ».«  4i  m  41  *>•■))<«<•>••■  iti  Hi «  4< « i(<  *  4i  .K  4: «  «4i  Ki  4i  W  Hi  Xi  Xi  W  ti  * 

REAL  MU 

DATA  GAMMA,'.  5772 156649,^ 

IF<nU.LT. .9999)  GO  TO  50 

MU  EG  1,0 

IF<TAU1 .NE. 0, 0)  GO  TO  10 

G2=<  TAU2- 1 . 0 )*EXP<  TAU2 )*E 1 < TAU2  >-GAMMA-ALOG<  TAU2  > 

GO  TO  100 

10  1F<TAU2,NE. 0. 0)  GO  TO  20 

G2=GAMMA+AL0G<TAU1  )+EXP<TAU1  >-*t  1  .0-TAUl  >kE1CTAU1  > 

GO  TO  100 

20  G2=EXP<TAU1  )*<  1  .  0-TAU1  )hiE1<TAU1  )-EXP<:  TAU2  )»<  1  ,  0-TAU2  >-*£1  <  TAU2  > 
G2=G2-K  ALOG<TAU1  )-ALOG< TAU2 > > 

GO  TO  i 00 

HU  NE  1.0 

50  Rr1=l  ,  0-t  .  O/’MU 

IF<TAU1 .HE.O.O)  GO  TO  60 
G2=EXP<;  TAU2/'MU  )*<  TAU2-MU  )*E  1  <:  TAU2  > 

G2=G2+MU-*E1  <  TAU2>*RM  > 

G2aG2+ 1 . 0+MU»ALOG<  AB9<  RH ) >-EXP< -RM*TAU2  > 

GO  TO  100 

60  IF<TAU2.NE. 0, 0)  GO  TO  70 

G2=EXP<TAU1/'MU>*<MU-TAU1  >-*El<TAUl  > 

G2=G2-MU*E 1 <  TAU1 ♦RM  > 

G2>=G2+EXP<  -RM*TAU1  >-MU»-ALOG<  ABS<RM>>-1  .0 
GO  TO  100 

70  G2-EXP<TAU1/'MU>h.<MU-TAU1  >*El<TAUt  > 

G2»G2-EXP<  TAU2/’MU  )*<  MU-TAU2  >*E1<  TAU2  ) 

G2=G2-K  EXP< -TAU 1 wRM )-EXP< -TAU2*RM ) ) 

G2=G2+MU* <  E 1  <  TAU21-RM  .»-E  1  <  TAU  1  ♦RM  >  ) 
too  RETURN 
END 


FUG0001 0 
FUC00020 
FUG00030 
FUG00040 
FUG00050 
FUG00060 
FUG00070 
FUG00080 
FUG00G90 
FUG001 00 
FUGOOt 1 0 
FUG00120 
FUG00130 
FUG00140 
FUGOOl 50 
FUG00160 
FUGOOl 70 
FUGOOl 80 
FUGOOl 90 
FUG00200 
FUG0021 0 
FUG00220 
FUG00230 
FUG00240 
FUG00250 
FUG00260 
FuG00270 
FUG00280 
FUG00290 
FUG00300 
FUCu031 0 
FUG00320 
FUG00330 
FUG00340 
FUG00350 
FUC00360 
FUG00370 
FUG00380 
FUGO03SO 
FUG00400 
FUG0041 0 
FUG00420 
FUG 00430 
FUG00440 
FUG00450 
FUC00460 
FUG00470 
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FUNCTION  EKX>  FUE0001  0 

COMMON  /lOUHJT/'IOlN. lOOUT, IPHFUN, LOUHIT, NOIRTU, NCLIMT, KSTOR , HPLOTUFUE00020 
>!•>•< oik**  if  4citii«ii|>4>*»l’t<«FUE0  0030 

FUE00040 

FUNCTION  COMPUTES  THE  VALUE  OF  THE  FIRST  EXPONENTIAL  INTEGRAL  FUE00050 

~£I<-y>  WHERE  -J74  <  X  <  170-  FOR  X  OUTSIDE  THESE  BOUNDS,  AN  FUE00060 

OVERFLOW  OR  UNDERFLOW  MIGHT  OCCUR,  SO  PROGRAM  EXECUTION  IS  FUE0D070 

HALTED.  POLYNOMIAL  AND  RATIONAL  FUNCTION  APPROXIMATIONS  ARE  FUE00080 

ADAPTED  FROM  THE  IBM  SCIENTIFIC  SUBROUTINE  PACKAGE,  SUBROUTINE  FUE00090 

EXPI.  FUEOOlOO 

FUEOul 1 0 

Ik  Ik*  **************************  *******«**ik******k<********s**ik*************FUE  00120 
DATA  GAMMA/’.  5772 156649/  FUE00130 

DATA  Cl ,C2,C3,C4,C5,C6,C7,C8/674 .567029,57.41 1833,6. 05529232,  FUE00140 

1 1699.06552,841 .654932,49.3133893,8.01957683, .99979204/  FUE00150 

DATA  D1 ,D2,D3,D4,D5,D6,D7, 08,09/248.6697,224.4234,32.43665,  FUE00160 

13.061037,. 05176245, 180.7837,22.63818,38.93944,3.995161/  FUE00170 

DATA  FI ,F2,F3,F4,F5,F6,F7.F8,F9/9.999999E-t ,2.500001E-t .  FUE00180 

15.555682E-2, 1 . 041576E-2, 1 . 664 1 56E-3 , 2 . 335379E-4 , 2 . 928433E-5 ,  FUE00190 

21 .766345E-6.7. 122452E-7/  FUE00200 

DATA  G1 ,G2,G3,G4, G5,G6, 07, G8/, 2677737343, 8. 6347608925,  FUE00210 

1 18. 059016973,8.5733287401 ,3.9584969228,21 . 0996530827,  FUE00220 

225.6329561486,9 . 5733223454/  FUE 00230 

IF<X.GT.-174. O.AND.X.LE. 170. 0>  GO  TO  10  FUE00240 

WRITE< lOOUT, 1000>  FUE00250 

STOP  FUE00260 

10  lF<X.GT.-9.0>  CO  TO  20  FUE00270 

El «1  . 0-<  Cl +C2*X-C3*X*X-X*X*X  >/<  C4*C5*X+C6*X*X-C7*X*X*X-C8*X*X*X*,X  )FUE00280 


E1=E1*EXP<-X>/X 
GO  TO  100 

20  IF<X.GT.-3.0)  GO  TO  30 

El  =D1  ■k02*X+03*X*X*D4*X*X*X+D5*X*X*X*X 

E1=< 1 . 0-El/<D6+D7*X+D8*X*X+D9*X*X*X+X*X*X*X>>*EXP<-X>/X 
CO  TO  100 

30  IF<X.GT. 1 .0)  GO  TO  40 

E 1  =F  1  -X*<  F2-X*<  FS-X-K  F4-Xi»<  F5-X*<  F6-X*<  F7-X*<  F8-X*F9  >>>>>>> 
E 1 iX*E I -GAMMA-ALOG<  ABS<  X  >  > 

GO  TO  100 

40  El  =<  G1 ♦X*<  G2*X*<  G3+X*< G44X  >)))/<  G5+X*<  C64X*<  G7+X*<  G8+X  >  > ) ) 
E1=E1*EXP<-X)/X 
too  RETURN 


FUE00290 
FUE00300 
FUE0031 0 
FUE00320 
FUE00330 
FUE00340 
FUE00350 
FUE00360 
FUE00370 
FUE003d0 
FUE00390 
FUE00400 
FUE0041 0 


1  000  FORMAT<4HOX  -, 3X, El  0 . 4 , 39H  OUT-OF-RANGE  FOR  El.  EXECUTION  HALTED . >FUE00420 
END  FUE00430 


SUBROUTINE  CRN|S»DE<  WrtVE  1  ,  ICLMhT ,  TRANS,  lERR  >  uRNOOOtO 

CV*  SUBROUTINE  GRNADE  !«ORN0003u 

C/*  MAIN  GRNADE  MODULE  <*GRN00040 

C/*  EOSAEL80  4>/GRN00050 

c  /  >k  «  *  41  i<<  *  >»  *  >)■  <•■  Ik  *  %  «  41  ■•■  *  *  *  *  4i  *  4i>«i  *  «  «  *  4< «  «  «  *  *  *  I*  *  1*  *  I*  *  « ■«■  Ki «  *  « ■(■  «  4>  4I «  41 «  *  *  Id  Hi  «  Hi «  «  « Ik  *  «  4I1|<  ,/>  ^  0  0  0  6  0 

DIMENSION  XA<3>,XTRAN<7;  GRN00070 

COMMON  /M05/  XOTA<  1  0 00  ) . CDTA<  1  00 0 >, CL<  1  0 0 0 >  GRN00080 

C0MM0N,^C0NST7PI  ,PI2,PIRAD,TU0PI,T0RRMB,CDECK  GRN00090 

COMMON  /lOUNIT/IOIH, lOOUT, IPHFUN, LOUNIT , ND IRTU , NCL 1 MT , KSTOR , NPLOTUGRNO 0 1 00 
COMMON/CLYMAT/'TEMP,PRESS,RH, AH,DP, VIS,CLDMAT,CLDHYT,FOGPRB,  GRN001 1 0 

•k  UNDVEL,UNDDIR,  IPASCT  GRN00120 

COMMON/MECHOi-'XM,  YM,ZM,X0,Y0,20,XT,YT,ZT,  ISTO,  lETO,  IDTO,XN,FW,  GRN0  0130 

♦  TBURN, ITYPE,EFF, YF,RHA,UU,UD, I  CAT , AIRT , TGRAD . BRATE , HEAD , RNG ,  GRN0014  0 

♦  DLEN, UPOWR, EXTC<  8  ), XMISC  8  ), XNORTH  GRN001 50 

COMMOH,''MECH1/XI<  1  >,  YI<  1  >,  ZI<  1  >,  TTI<  1  >,EMUN,BREXP  GRN0  0t60 

C0MM0N/MECH2/'U2,UDA,THETA,UBXB,QLENTH  GRN001 70 

C0MM0N,'’MECH3/2DIFF,YDIFF,SIGZR,XREF2,WINDP,HK,  VS,RC,HM  GRN00180 

CikHiHiH<Hi4iHi4iHi>k4iHi<kHiHi4i<k4iHiHi4iHiH<Hi4iHiH<Hi4i’k4i4iH<HiHiHi4iHiHiHi4<4iHiHi4iHiHiHi4iHiHi>k4iHi4iHiHiHiHiHiHiHi4iHiHi4iHiHi4i4i4<GRN  0  019  0 


I,** 

CHi* 

c** 

c** 

c** 

c** 

c** 

C»*'**‘ 

c*# 


THE  FOLLOWING  VARIABLES  SUPPLIED  BY  THE  USER. 

FIELD  DATA 
XNORTH 
HEAD 
RNG 
DLEN 

XO, Y0,20 
XM,YM,ZM 
XT, YT,ZT 
METEOROLOGICAL 
WINDP 
HM 
UD 
US 
RH 

ICAT 
YF 

MUNITION  DATA 
EFF 
QMUN 

DETECTOR  DATA 

UAVE1  UAVELENGTH  OF  INTEREST  < MICRONS) 

DIFFUSION  PARAMETERS 

SIGZ  REFERENCE  SIGMA  < METERS) 

XREF  REFERENCE  DISTANCE  <METERS> 

ZDIFF  VERTICAL  DIFFUSION  CONSTANT 

YDIFF  CROSSWIND  DIFFUSION  CONSTANT 

HK  TERRAIN  SCAVENGING  COEFFICIENT 

VS  PARTICLE  SETTLING  VELOCITY  <CM/SEC) 

RC  TERRAIN  REFLECTION  COEFFICIENT 


FIELD  COORDINATES  FROM  NORTH  < DEGREES) 

GRENADE  TANK  HEADING  CLOCKWISE  FROM  NORTH  < DECREES) 
DISTANCE  OF  GRENADES  FROM  TANK  C METERS) 

GRENADE  SPACING  < PERPENDICILAR  TO  HEADING) 
COORDINATES  OF  OBSERVER  <MET£RS) 

COORDINATES  OF  TANK  < METERS) 

TARGET  COORDINATES  < METERS) 

DATA 

UIND  PROFILE  EXPONENT 

HEIGHT  OF  INVERSION  LAVER 

UIND  DIRECTION  FROM  NORTH  < DEGREES) 

UIND  SPEED  < METERS  PER  SECOND) 

RELATIVE  HUMIDITY 
PASQUILL  CATEGORY 
SMOKE  YIELD  FACTOR 


CLOUD 

TOTAL 


■MAKING  EFFIENCY  OF  MUNITION 
NASS  OF  SMOKE  AGENT  < GRAMS ) 


GRN00200 
GRNU021 0 
GRN00220 
GRN00230 
GRN0024U 
GRN0025U 
GRN00260 
GRN00270 
GRN00280 
GRN00290 
CRN 003 00 
GRN0031 0 
CRN 00320 
GRN00330 
GRN00340 
GRN00350 
CRN003S0 
GRN0037U 
CRN00380 
CRN 00390 
GRN00400 
CRN 0041 0 
GRN00420 
GRN00430 
GRN00440 
CRN00450 
GRN00460 
GRN00470 
GRN00480 
GRN00490 


C  %  4i  Hi  Hi  Hi  4i  Hi  Hi  Hi  Hi  Hi  Hi  Hi  4l  Hi  Hi  Hi  4i  Hi  Hi  Hi  Hi  Hi  Hi  4i  Hi  Hi  k  Hi  Hi  4i  4i  Hi  *  4i  Hi  Hi  Hi  ik  Hi  Hi  Hi  Hi  Hi  Hi  Hi  Hi  4i  >k  Hi  Hi  Hi  *  Hi  Hi  4i  4i  Hi  Hi  Hi  Hi  Hi  Hi  Hi  Hi  Hi  Hi  Hi  Hi  Hi  Hi  Q  R  N  0  0 5  0  0 


CkHi 

CHiHi 

Ck* 

Ckk 

CkHi 


DEFINITIONS 
IXMAX 
NBPT 
NTARG 
TBURST 


OF  OTHER  VARIABLESHok*  CRN0051  0 

NUMBER  OF  POINTS  ALONG  LINE-OF-SIGHT  FOR  CL  COMPUTAIOGRN00520 


NUMBER  OF  GRENADE  LINES  <N6PTii 
NUMBER  OF  TARGETS  <NTARG-1) 
MUNITION  DETONATION  TIME 


1  ) 


c  k  k  Hi  k  Hi  k  Hi  k  Hi  Hi  k  Hi  Hi  Hi  Hi  Hi  Hi  Hi  Hi  k  k  k  Hi  Hi  Hi  k  Hi  k  Hi  Hi  k  Hi  Hi  Hi  k  *  k  k  Hi  Hi  Hi  Hi  k  Hi  Hi  Hi  k  k  k  Hi  Hi  k  k  k  k  Hi  Hi  Hi  Hi  Hi  Hi  Hi  Hi  Hi  Hi  Hi  Hi  k  Hi  Hi 

Ckk  error  codes  and  option  CODES; 

Ckk  IWRITkl  DEPRESSES  RAW  DATA  PRINTOUT 

Ckk  IFLAoM  INVALAD  DATA  CARD  <BUT  IGNORED) 

Ckk  IFLAG-3  OVER  11  DATA  CARDS  ENTERED  BEFORE  GO 

Ckk  REMAINDER  IGNORED 

Ckk  IFLAG-2  NORMAL  READ  TERMINATION 

Ckk  IFLAG-I  WAVELENGTH  OF  INTEREST  NOT  IN  DEFINED  BANDS 

Ckk  TRANS  SET  TO  1 , 0 

CkkkkkSET  DEFAULTSkkkkkkk 
TBURST-0. 0 

CALL  GOGET<UAVE1 ,KUAVE) 

CkkkkkREAD  DATA  AND  WRITE  HEADlNGkkkkk 
WRITE< lOOUT.SOOO) 


GRN06530 
CRNCI0540 
GRN00550 
CRN00560 
GRN00570 
GRN00580 
GRN00590 
GRN00600 
GRN0061 0 
GRN00620 
GRN00630 
GRN00S40 
GRN00B50 
GRN00660 
GRN00670 
GRN00680 
GRND0690 


800  0  FORMAT< 1  HO , 20X , 40< 2Hkk ) , K , 21 X , 1Hk,34X, 14HPR0CRAM  GRNADE, 30X, 1 Hk , / , GRN007 00 
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*2iX,  1H*,37X,eHELiSrtEL80,33X,  1H*,/’,2tX,40<  )  ) 

IURIT=1 
IFLAG=0 

b  CALL  DATRD< lURIT. IFLAG) 

IERR=IFLAG 

IF<  IFLAG.ECI.4>G0  TO  9999 

c*ii>#*>i<»calculhte  integration  increment 

XX=(;  XT-XO  >*Xi2+<  VT-YO  )**2-K  ZT-ZO  >**2 
DLu3=SQRT( XX ) 

IXMAX=IFIXa>LOS> 

IF< iXMAX.GT. 1 0uu>IXMAX=1 uOO 
C*****DEFAIJLT  to  CLIMATE  DATA  OPTION 
IF< ICLMAT . NE . 1 >GO  TO  12 
RHA=RH 
UU=iJNDVEL 
UIC>=WNDDIR 
ICAT=IPASCT 
12  CONTINUE 

IFc'  DLEN  .  EQ  .  0  .  u  )0LEN=  10.0 
IF<BRATE.EO.  0,  0  )EiRATE=(  1.0X14.3) 

QLENTH=XN*DLEN 

BREXP*BRATE 

QMUN=XN=*'Fii( 

EMUN=QMUNfYF*EFFX1 00 . 0 
US>UU 

IF<XMISC 1 ).LE. 0. 0)GO  TO  4 
XREFZ=1 00 . 0 
SIGZR-XMI6<  1  ) 

ZulFF=XMlS<2) 

YDIFF=XMIS<3) 

HM=XMIS<4) 

Hk=XMIS<5) 

RC=XMIS<6) 

VS=XMIS<7> 

GO  TO  5 

4  CALL  PARMS<ICAT) 

5  CONTINUE 

C***:4.*RE0EFINE  wind  profile  exponent  IF  READ  IN  POSITIVE 
IF<UiPOWR.GE.  0. 0)UIINDP=WPOWR 
IF<UIS.LE.0.0>  WS»0.1 
U2=WS 


LOCATE  GENERATING  LINE 


THETA=< HEAD-UD  )fP I  RAD 
***  LOCATE  CENTER  OF  GENERATING  LINE. 
YHEAD=<  XNORTH+90 . 0-HEAD  )t>PIRAD 
XBURST=RNGfSIN<  VHEAO )+XM 
YBURST=«RNG*COS<  YHEAD  >+YM 
ZBURST-=ZM 


TRANSFORM  TO  OBSERVER  COORDINATES 


**  TRANSFORM  TO  ORIGIN  UNDER  OBSERVER  AND  X-AXIS  UNDER  TARGET. 
ANCLR=ATAN2<  YT-YO, XT-XO  ) 

Xl< 1  >»<  XBURST-XO )*COS<  ANGLR  >+<  YBURST-YO )*SIN< ANGLR  > 

YI< 1  >-<  YBURST-YO  )*COS<  ANGLR  )-<  XBURST-XO )*SIN<  ANGLR  > 

ZK  1  )  -  2BURST 
TTI< 1  )  -  TBURST 

GET  THE  WIND  DIRECTION  ANGLE  WITH  THE  NEW  X-AXIS. 

ANGLD  -  ANCLR>i>180.XPI 
WX=-<  WD+XHORTH+ANGLD ) 

UX=iAMOD(UX,  360.0) 

WDA  “  WX*PIX180. 


WRITE  INPUT  DATA  AND  HEADINGS 


WRITE< IOOUT,e001 ) 
WR1TE< lOOUT, 1000) 


WR1TE< lOOUT, 1 001 )WS,WD, I  CAT , RHA, XNORTH 


GRH0071 0 
CRN00720 
GftN00730 
GRN00740 
GRN00750 
GRN 00760 
GRN00770 
GRNOOZeO 
GRN0u790 
GRN00800 
GkNuOBI 0 
GRN 00820 
GRN00d30 
GRN00840 
GRN00850 
GRN00860 
Gknu0870 
GRN00880 
GRN00690 
GRN 009 00 
GRNOOSi 0 
GRH00920 
GRN0093U 
GRN 00940 
GkNuu95u 
GRI  00960 
GRN0u970 
GRN 00980 
GRN00990 
GRNOt  000 
GRNOt  01 0 
CRN01 020 
CRN01 030 
GRNOt  040 
GRN01 050 
GRN01 060 
GRN01 070 
GRN01 080 
CRN01 090 
CRN01 1 00 
GRN01 1 1 0 
GRNOt 120 
GRNOt 130 
GRH01 140 
GRH01 150 
GRN01 160 
GRNOt 170 
GRNOt 180 
GRNOt 190 
GRN01200 
GRN0121 0 
GRNOt 220 
GRN01230 
GRN01240 
CRN01250 
GRN01260 
GRN01270 
GRNOIZeO 
GRN0t290 
GRN01300 
GRN0131 0 
GRN01320 
GRN01330 
GRN01340 
GRN01350 
GRN01360 
CRN01370 
GRN01380 
GRN01390 
GRN0t400 
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wRITE<  luOUT,  998  j  GRNOMiO 

URITEC 100UT,995)  GRN01420 

URITE<  100UT,997)X0,EXTC':  1  ) ,  YO .  EXTC<  2  ) ,  20 .  EXTCiT  3  ) ,  GRN0M30 

*XT , EXTC<  4  > , YT , EXTC<  5  > , 2T , EXTC<  6  >, EXTC<  7  )  GRN 0 144  0 

WR1TE< lOOUT, 1 002 >  GRN01450 

WRITE< lOOUT, 1  0  03  )XM , SI G2R , YM , XREF2 , 2H , HM  GRN0146  0 

URITEC lOOUT, I 004)HEAD,HK,RNG,RC,XN,VS  GRN01470 

URITE< lOOUT, 1 005>QMUH,WINDP,GLENTH,ZDIFF.BREXP, YDIFF  GRN01480 

UIR1TE<  lOOUT,  1  006)EFF,  YF  GRN01490 

8001  FORMftT<  21  X,  36H**>«**INPUT>f»**>»ALL  LENGTHS  IN  METERS,/,  GRN015C0 

■*'21X,38<2H — ))  GRN01510 

1  000  F0RMAT<21X, ISHMETEOROLOGICPLi  )  GRN01520 

1001  F0RM8T<24X, 1 OHUIND  SPEED, 1 0X,F6. 1 , 1X,3HM/S,/,  GRN01530 

*  24X,14HWIND  D IRECT I  ON , 6X, F6 . 1 , 1 X . 3HDEG , / ,  GRN01540 

*  24X, 1 7HPASQUILL  CATEGORY , 3X , 1 3, / ,  GRN01550 

*  24X,  1  7HRELATIVE  HUM  I DI  TY ,  3X ,  F6 . 1  ,  1  X ,  1  HK , ,  GRN01560 

*  24X,21HN0TE:  X  AX  I S  HEAD ING : , 1 X , F6 . 1 , 1 X . 3HDEG , 1 X ,  GRH01570 

*  2SHCL0CKWISE  FROM  NORTH  <DCWFN)>  GRN01580 

1002  t-ORMAT< 20x, 1 9HTANX/MUNITI0N  DATA : , i6X, 21H&IFFU5IuN  PARAMETERS!)  GRN01590 
1  003  FORMAT< 24X, 7HX< TANK  1, 12X,F6, 1 , 1  OX, 1  OHS IG2< XPEF i , 2 1 X , F6 , 1 GRN01600 

*  24X,7HY<TANK), 12X,F6. 1 , 10X,4HXREF,27X,Fb. 1 ,/,  GRN01610 

*  24X,7HZ(TANK), 12X,F6, 1 , 10X, 17HMIXING  HEIGHT< HM >, 1 4X, F6 , 1 )  GRN01620 

1  004  FORMAT< 24X, 14HHEADING< DCWFN  ), 5X,F6. 1 , 1 0X,20HSCAVENGING  COEFF<HK>,  GRN01630 

*1 1X,F6 . 3, /, 24X,5HRAHGE, 1 4X, F6 . 1 , 1  OX , 20HREFLECT I  ON  COEFF<  RC  >,  1 1 X,  GRN 01 64  0 

‘*F6.3,/,24X,  1  OHNO  GRNADES ,  9X ,  F6 . 1  ,  1  OX ,  2 1  HSETTL  I NG  VELOC I T  Y<  VS  ) ,  GRN01650 

*5X,F6 .3, 1X,4HCM/S>  GRN01660 

1  005  F0RMAT<24X, 14HSM0KE  MASS< GM  ) , 3X , F6 . 1 , 1  OX , 29HVERT ICAL  WIND  EXP0NENTGRN01 670 


■*<WP0WR),2X,F6.3,/,24X.  1  INLINE  LENGTH,  8X ,  F6 . 1  ,  1  OX, 

■••29HVERTICAL  DIFF  CONSTANT<  2DIFF  ),  2X,  F6 . 3, /, 

*24X, 13HBURN  CONSTANT , 2X , F6 , 3 , 1X,3H1/S, 1  OX, 

*  30HCROSSUIND  DIFF  CONSTANT< YD  I FF ), 1 X, F6 . 3  ) 

1 006  F0RMAT<24X, 1 OHEFF I C I ENCY , 9X, F6 .1,1  OX, 12HYIELD  FACTOR, 17X,F6 . 1  ) 
998  F0RMAT<21X, 1 6H0BSERVER/TARGET i  .8X,24HEXT1NCTI0N  COEFFICIENTS:  ) 

995  FORMAT<  49X , 7HM I  CRONS , 3X , 7HM*k2/GM  > 

997  FORMAT<  24X , 6HX<  OBS  > , 3X , F6 . 1 , 1  OX , 7H0 . 4- 0 . 7 , 3X , F6 . 3 , / , 

*  24X,6HY<0BS),3X,F6. 1 , 1 0X,7H0.7-1 . 2, 3X, F6 , 3, /, 

*  24X,6HZ<0BS>,3X,F6. 1 , 1 0X,7H  1,06  ,3X,F6.3,/, 

*  24X,6HX<TAR  >,3X,F6. 1 , 1  OX , 7H3 . 0-5 , 0, 3X, F6 . 3 , / , 

»  24X,6HY<TAR),3X,F6,1 , 1 0X,7H8. 0-12. ,3X,F6,3,/, 

*  24X,6H2<TAR),3X,F6, 1 , 1 0X,7H  10,6  ,3X,F6,3,/, 

*  49X,4H94. 0, 1X,3HGH2,2X,F6.3> 

WRITE< I00UT,996) 

996  F0RMAT<  1H1 ,21X,  1  6H**>fi.>*.0UTPUTf>ff  *♦, /,  21 X,  38<  2H—  )> 

WRITE< IOOUT,3000) 

300  0  FORMAT<  24X ,  4HT IME ,  6X ,  2HCL ,  23X ,  1  2HTRANSMISSI0N,  /  ,  24X,  5H(  SEO,  2X, 
*9H<GM/M*’*'2),2X,7H0.4-0,7, 1 X ,  7H  0 . 7-1  .  2 , 3X ,  4H 1  .  0e,2X,7H3. 0-5. 0,  IX, 
*7H8. 0-12. ,2X,4H1 0.6,4X,5H94GH2> 

bEgIN  cl  CALCULATIONi 


DO  400  IT=ISTO, lETO, IDTO  GRN01910 

ITT=IT  GRN01920 

C  *  SET  UP  LOOP  ON  SPACIAL  DISTRIBUTION  GRN01930 

XC  =  0.0  GRN01940 

YC  =  0.0  GRN01950 

ZC  =  20  GRN01960 

DELX*‘SGRT<  <  XT-XO  >*’«'2-*-<  YT-YO  )*>»2  >/IXMAX  GRN01970 

DEL2  =  < ZT-20  )/IXMAX  GRN01980 

C**  FOR  EACH  '.IME  GET  THE  CONCENTRATION  AT  IXMAX  POINTS  ALONG  LINE-OF-3IGRN01 990 
DO  300  IX-1, IXMAX  GRN02000 

XC  =  XC  +  OELX  GRN02010 

ZC  =  ZC  +  DEL2  GRN02020 

XA< 1  )  =  XC  GRN02030 

XA<2>  =  YC  GRN02040 

XA<3)  =  2C  GRN02050 

T  -  FLOAT<IT)  GRN02060 

UBXB=U2  GRN02070 

CALL  CONCN<XA,T,C>  GRN02080 

XDTA<IX>-XC  GRN02090 

CDTA<IX>=C  GRH02100 


GRN01680 
GRN01690 
GRN01700 
GRN0171 0 
GRN01720 
GRN01730 
GRN01740 
GRN01750 
GRN01760 
GRN01770 
GRN01780 
GRN01790 
GRN01800 
GRN0181 0 
GRN01820 
GRN01830 
GRN01840 
GRN01850 
GRN01 860 
GRN01870 
GRN01880 
GRN01 890 
GRN01900 
GRN01 91 0 
GRN01920 
GRN01 930 
GRN01940 
GRN01 950 
GRN 01 960 
GRN01970 
GRN 01 980 
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ooo  ooo  o 


300  CONTINUE 

integrate  along  line-of-sight  to  get  cl. 

CALL  SUMA  <XDTA.Ct)TA,  CL  ,1XMAX> 


calculate  TRANSMITTANCE 


DO  500  J=1 , 7 

XTRAN<  J>=EXP<-1  .  0HiEXTC<  J)*CL<  IXMAX)> 

500  CONTINUE 

WRITE< IOOUT,2000>T,CL< IXMAX >, < XTRAN< J >, J= 1 , 7 > 
2000  F0RMAT<23X,F5 . 1 , 2X , F8 . 3 , 2X , 7< 1 X , F7 . 3 ) ) 

400  CONTINUE 

♦  **-f*SET  TRANSMISSION  FOR  RETURN  TO  EOSAEL 

IFCKWAVE.GT. 0>GO  TO  3 

TRANS=1 . 0 

IFLAG=1 

3  TRANS=XTRAN<KWAVE) 

CO  TO  6 

9995  URITE< IOOUT,9000 J 

9000  F0RMAT<21X,28H»f*<*>**PR0GRAM  GRNADE  END***’*'*  > 
RETURN 
END 


GRN021 1 0 
GRN02120 
GRN02130 
-GRH02140 
GRN0215G 
GRN02160 
GRN02170 
GRN02180 
GRH02t90 
GRN02200 
GRN0221 0 
GRN02220 
GRN02230 
GRN02240 
CRN02250 
GRN 02260 
GRN02270 
GRN02280 
GRN02290 
GRN02300 
GRN 0231 0 
GRN02320 
GRH02330 
CRN 02340 


SUBkOUTIHE  C0NCN< XA, T, C2  )  COCOOulO 

C/*  SUGROUTIriE  CONCN  >*/  COCOOOSu 
Cr'*  GRNf^D  MODULE  */  COC00040 
C/*  EOShELBO  */  COC00050 

COCO  0  06  0 

C/*  PURPOSE:  */  COCOOit70 
C/*  CALCULATES  CONCENTRATION  AT  A  SPECIFIED  POSITON  AND  TIME.  COCOOuSO 
C/*  USAGE:  */  COCOuOSO 
C7>»  THE  CONCENTRATION  IS  USED  WITH  THE  EXTINCTION  COEFFICIENT  •*/  COC00100 
CX*  TO  COMPUTE  TRANSMITTANCE.  */  COC00110 
C/*  DESCRIPTION  OF  PARAMETERS:  COC00120 


c/* 

XA 

-  POSITION  IN  METERS,  INPUT. 

COCOO 1 30 

c/* 

T 

-  TIME  IN  SECONDS,  INPUT. 

*/ 

COC00140 

c/* 

C2 

-  CONCENTRATION,  OUTPUT. 

COCOO 150 

C7*  SUBROUTINES  AND  FUNCTION  SUBPROGRAMS  REQUIRED: 

C,'*  LOCAT  UMEAN 

C7*  COMMON  BLOCK  STATEMENTS  REQUIRED; 

C/*  MECH1  MECH2  MECH3 

C/*  REMARKS ; 

C/*  CONCN  COMPUTES  FIVE  TERMS  AND  MULTIPLIES  THEM  TO 

C/*  GET  CONCENTRATION. 

.C 4i  «« 4> « :|c .H 4! IK « III in ««««««  «« .ft :ti ^X**:** 4' ^ ^ :«< :4ci<t 7 

DIMENSION  XA<3> 

C0MM0N/'C0NST7PI ,  PIS,  PIRAD,  TWOPI  >  T0RRM8,CDECK 
C0MM0H/'MECH1/XI<  1  > ,  VI <  1  ) ,  ZI<  1  > ,  TT I<  1  >,EMUN,BREXP 
COMMON/MECNZ/UZ , WDA , THETA , UBXB , QLENTH 

C0MM0N7MECH3/2DIFF, YDIFF, SIG2R,XREFZ,UINDP, HK, VS, RC,HM 


*/ 

*/ 

*/ 

*/ 

*/ 

*7 


C- 

c 

c- 


C0NCENTRATI0H=TERM1*TERM2*TERM3*TERM4*TERM5 


C2  =  0.0 
X  “  XA< i  > 

Y  =  XA<2> 

2  =  XA<3; 

GET  CROSSWIND  AND  DOWNWIND  COMPONENTS  OF  GENERATING  LINE, 
QC=ABS<  QLENtH*COS<  THETA ) > 

CIO=AeS<  QLENTH*SIN<  THETA  )  .■) 

NBPT=1 

DO  380  J  =  1,NBPT 
TJ  =  T-  TT1<  J) 


C- 

C 

C- 


C— 

c 

c — 
c** 


TERM1  IS  CLOUD  MASS  AS  A  FUNCTION  OF  TIME, 

IF<BREXP>fTJ.GE.200.  O  tSTOPoI 
TRM1 =EMUN*< 1  . 0-EXP< -BREXP*T J  > ) 

TERM2  IS  TERRAIN  SCAVENGING  TERM, 


CHANGE  TO  SMOKE  COORDINATES, 

f  ol  I  i  nr6T<f  .1  y  V  7  VR  VR  7R  i 
C***  UPWIND  END  OF  GENERATING  LINE  WILL  BE  ORIGIN  OF  SMOKE  SYSTEM, 
XB=XB+0 , 5*QD 
CALL  UMEAN<  J,TJ) 

IFCHKfXBXUBXB.GE.ZOO. OJSTOPOt 
TRM2  =  EXP<-HK*XBXUBXB) 


C- 

C 

C- 


C- 

c 

c- 


TERM3  IS  DOWNWIND  PROBABILITY  DENSITY. 

UT=UBXB*TJ 

IFCXB.LE. 0. >  GO  TO  999 

IFCXB.GT.  0.  ,  AND,XB.LE.UT>  TERM3-1  . /<  UT+0  ,  ShiQD  > 

IF<  XB  .  GT  .  UT  .  AND  ,  XB  .  LE  .  UT+QD  >  TERM3=<  UT+QD-XB  >/<  UT*QD+  0 . 5h.QD>*QD  ) 
IF<XB.GT,UT+QD>  TERM3*0. 

TRM3=TERM3 

TERM4  IS  CROSSWIND  PROBABILITY  DENSITY. 

YWIDTH-YDIFF*XB+QC 
TRM4=  t./YMIDTH 


COC001 60 
COC001  fit 

coco  01 80 
COC001 90 
COC  0  02  0  0 
COCO 021 0 
COC00220 
COC00230 
COC 00240 
COC00250 
COC00260 
COC00270 
COC00280 
-COC00290 
COC 003 00 
-COC0031 0 
COC 00320 
COC00330 
COC;00340 
COC00350 
COC00360 
COC00370 
COC 00380 
COC00390 
COC 004 00 
COC0041 0 
-COC00420 
COC 00430 
-C0C00440 
COC00450 
COC00460 
-COC00470 
COC 00480 
-COC00490 
COC 005 00 
COC 0051 0 
COC00520 
COC00530 
COC00540 
COC00550 
COC  0  0560 
-COCOOSr  0 
COC00580 
-COC 00590 
COC 006 00 
COC0061 0 
COC 00620 
COC00630 
COC 00640 
COCOO650 
-COC00660 
COC00670 
-COC006dO 
COC00690 
COC00700 
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IPCYB  .GT.  0.5*YUIDTH  >  TRM4-0. 

IF<  YB  .LT.  -0.5H.YUIDTH)  TRM4*0. 


C- 

c 


TERMS  IS  VERTICAL  PROBABILITY  DENSITY. 


S I G2T=»S  I  GZR*<  XB/XREFZ  >f>*ZD  I FF 
S2T2=SIG2T*3IGZT 

HMVT  =  2I<J>  -  <  VS/1  00. 0>>*<XB/'UBXB> 

TV1  *  EXP<-<HMVT-2B>'*f2/'t2.0*SZT2)> 

TV2  =•  RC*EXP<-<HMVT+ZB>*i<'2/'(2. 0*SZT2>> 


370 


371 


380 

995 


TERR 
JC  = 

T1  = 

T2  = 

T3  =  _  . 
T4=  0.0 


=  t  .  OE-06 
0 
0 . 

0. 

0, 


T  3  ■  0.0 
OC  =  JC+1 
Rt  =  RC**<  JC-1  i 
R2  =  RC**JC 
R3  *  RC**< JC+1  ) 

IF<  <2.»JC>*HM+HMVT+ZB)i»H.2 


.GT.  6  00.'»2.'*S2T2>  GO  TO  371 


T1  =  R1*EXP<-<2. 0i>JC>»HM-HMVT-2B>>»-*2/'<2. 0*32T2>> 
T2  »  R2fEXP<-<2. 0*JC*HM-HMVT+2B)>**2/’<2.0*S2T2>> 
T3  »  R2*EXP< -(  2  .  O*  JC'*'HM-»HMVT-26  >’*'*2/^<  2 . 0*SZT2  >  > 
T4  -  R3*EXP<-<2.0‘»JC4.HM+HMVT+2B>*f2.-'<2.0»3ZT2>> 
T1234  »  T1  +72+73+74 
TS  »  T3  +  T1234 
IF<T1234  -  T£RR>  371,371,370 
CONTINUE 
TV3  =  TS 

TRM5  =  TV1+TV2+TV3 
TRM5=TRM5/’<  SIG2T+SQRT<  2  .‘•Pl  )  ) 

Cl  »  TRM1*TRM2+TRH3+TRM4'*TRH5 

C2  =  C2  +  Cl 

CONTINUE 

RETURN 

END 


COC0071 0 
COC00720 
-COC00730 
COC00740 
-COC00750 
COC00760 
COC00770 
COC00780 
COCO 0790 
COC00800 
CuCOOdl 0 
COC00820 
COC00d30 
COC00S40 
COC00S50 
COCO 0880 
COCO 0870 
COCO 0880 
COC0U890 
COC00900 
COC0091 0 
COC00920 
COCO 0930 
COCO 0940 
COC00950 
COCO 0960 
COC00970 
COC00980 
COC00990 
COC01 000 
COCOl 01 0 
COCOl 020 
COCOl 030 
COCOl 040 
COCOl 050 
COCOl 060 
COCOl 070 
COCOl 080 


SUBROUTINE  GOGET<«AVE1 ,KUAVE  ) 

Q /*  )(i  4c  %  Ki  it  >*(**((  >l<  *0  ^  ^  ^  ^  ^  ^  ^  4t  4i  ♦  ♦ 

C/*  SUBROUTINE  GOGET 

C^*  GRNAD  MODULE 

C/’*  EOSAEL80 

(j  /  Hi  *  H  Xi  >*<  4i  ■•■  ><■  4<  Ki  4>  Ki  ><•  %  >l<  ><•  >*  >•■  4<  <•  ■ti  4i  »■  4>  4i  >ti  Oi  >*  >ti  ■)<  4i  ti  4i  41  ■*  <k  >)■  ■* 

CH.H.H.H.H1SUBROUTINE  FINDS  SPECTRCiiL  BAND  FOR 
KWAVE=0 

IF<UiHVE1  .GE.  0.40.HND.yAVEt  .LT.  0.7  0 
IFCWAVE)  .GE. 0. 7  0. AND, WAVE  1  .LT. 1 .20 
IFtWAVEl .GE.3. OO.AND.UAVEI  .LT.5. 00 
IF<UAVE1 .GE. 8. OO.AND.UAVEI .LT. 12. 0 
IF(;UAVEt  .EG.  1  .  0b> 

IF<UAVE1 .EG. 1 0,6) 

IF('  UAVE1  .  EG  .  94 . 0  ) 

IF<WAVE1 ,GT.31S8, O.AND.UAVEI ,LT.31 

RETURN 

END 


4i  it  it  41 41  %  4c  4c  it  4c  41 it 


it  it  it  it  4i  it  it  it  it  ii  ii  41  ic 

GIVEN  SINGLE 

>KUAVE-1 
>KUAVE=2 
>kUAVE=4 
>KUAVE-5 
kuAVE>‘3 
KUAVE=6 
KUAVE*7 
95. 0>KUAVE=7 


GOGOOul 0 

HiHiHiHiH’4iHiHiHiHi4iHiHiHiHiHiHiH!/'GOG0  002  0 
hi7GOGu0030 
•/GOG 00 040 
•/GOGOOCSO 

iiititiciciiiiiiititiiiiiiitiiiiiiiiyQQQ  0  0060 

WAVELENGTH  GOG00070 

GOG  0  0 080 
GOG00090 
GOG001 00 
GOG001 1 0 
GOCOOI 20 
GOG001 30 
GOGOOl 40 
GOGOOi 50 
GOGOOl 60 
GuGOOt  70 
GOG00180 


SUBROUTINE  PARHS<ICAT> 

^ >ti  *  Hi  mik  *  in  •  «  «  41 4iik  41  Hi  Ik  >«■ ««  Ik  4II|I  lit  Ik  Ik  itiiti  41  *  «  *  «  4<  Ik  «  *  I*  *  4i  I*  4i  Ik  4t  Idili  4<  *  Sk  41 «  * 

c/f  SUBROUTINE  FARMS 

C/*  GRNAD  MODULE 

C/*  EOSAELSO 

C <|i  4i  4i  Hi  *  4ii|t  4i  ill  4i  i|(  Hi  lit  4i  •  41  •  >li  4c  4i  lit  41  4t  4<  4i  4i  9|(  4i  4i  %  111  41 4i  41 4i  4i  4t  4i  4t  4t  4c  %  4: 

C4i4<4.ik4.SETS  DIFFUSION  PARAMETER  DEFAULTS  AS  FUNCTION  OF 

C0MM0N/'MECH3/'2DIFF,  YDIFF,SIG2R,XREF2,MINDP,HK,  VS>RC,HM 
YDIFF»iO,355 
HK=0 . 002 
VS=0.021 
RC-0 . 70 
XREF2-1 00.0 
IF< ICAT.GT.3)G0  TO  1 
WIHDP=0 . I  0 
2DIFF*2. 06 
HM=1 000.0 
S1GZR=M.  0 
GO  TO  3 

1  IF< ICAT.GT.4>G0  TO  2 
UINDP=0.20 

2DIFF=1 .40 
hM=300 . 0 
3IG2R=7.2 
GO  TO  3 

2  i<IINDP-0.40 
2DIFF=1 . 04 
HM=50. 0 
SIG2R-5. 0 

3  RETURN 
END 


PAROOOl 0 
<k  *  4<  4<  41 4i «  4i  <k  4i  4<  4i  4>  4i  4c  4<  >k  /  P  A  R  0  0  0 2  0 
♦.'’PAROOOSo 
*/PAR00040 
♦  c^PAROOOSO 

ik4i4i4i^4i4i4iifr4c4i4i4i4c4i4i4i<^PAR  0  0060 

PASQUILL  CATEGORYPAR00070 
PAROOOSO 
PAR00090 
PAROOt  00 
PAR001 \ 0 
PAR00120 
PAR00130 
PAR00140 
PAR00150 
PARG0160 
PAR00170 
PAROOteO 
PAROOtSO 
PAR00200 
PAR0021 0 
PAR00220 
PAR00230 
PAR00240 
PAR00250 
PAR00260 
PAR00270 
PAR00260 
PAR0O29O 
PAR00300 
PAR0031 0 
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SUBROUTINE  EXT1H<EX> 

c  y  *****•»>•>*■(•  ■1' ’t' ^ 

C/*  SUBROUTINE  EXTIN  * 

CX*  GRNND  MODULE 

CV*  E05REL80 

Cy*****>»>>)'***'*>i'*>t>‘f*><ci»**»*****ii>it>**i**<»*H'***’t'’i'‘<i>*  + 

C*****PROGRhM  to  set  EXTINCTION  COEEFICIENTS  FOR  WP/RP  SMOKE**** 
DIMENSION  EX«;7j,CX<?) 

DPTP  0X74. 304, 2. 166,1.541, 0 . 350, 0 . 338, 0 , 364, 0. OOtX 
DO  1  1=1,7 


1 


EX< 1  )=CX< I  ) 
CONTINUE 
RETURN 
END 


EXTN001 0 
XEXTN0020 
/EXTN0050 
XEXTN0040 
XEXTN0050 
XEXTN0060 
EXTN0070 
EXTN0080 
EXTN0090 
EXTN01 00 
EXTNOl 1 0 
EXTN(il2Ci 
EXTNOl 30 
EXTN0140 
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c/**  *% 

c/* 

C<-'* 

c/* 


1  0 


dO 

30 
4  0 


50 

151 

155 

159 
1  bO 
20  0 

1  000 


SUBROUTINt  UMtAN<J,TJ; 

:*!♦  Id*  **j(<*****i*c***>t>*>fH>  *■»•*★***>••*•*■**>••>••■••  ■•«♦■»**•*■<>**** 

SUBROUTINE  UMEhN 
GRNAD  MODULE 
EOSAELdO 

’OX’**** 

CALCULATES  MEAN  WIND  SPEED  OVER  EXTENT  OF  CLOUD 
COMMON,-’MECHl/'XI<  1  i,YI<  1  >y2I<  1  >^TTI<  1  >,EMUN^BREXP 
C0MM0NXMECH2/U2 , WDA, THETA , UBXB , QLENTH 
COMMON/MECHS/ZDIFF, YD1FF,SIGZR,XREFZ,W1HDP,HK. VS,RC,HM 

IC  =  0 

QD  =  ABS<:QLENTH*SIH<  THETA 
P  »  UINDP  +1.0 
C1=P*2. 0**WINDP 
22=2I<  J) 

IF<22-2. 0)1 0, 10,20 
CONTINUE 
22=2.0 
21=0. 01 
GO  TO  200 

21=ZI<  J>-i .5*SIG2R 
IF<21 >30,30,40 
21=0.01 

CONTINUE  ^ 

UH  =  <  U2/'<<  22-2  i  >*Cl  .>.>*<  ^ii**P-21**P^ 

U3=UH 
CONTINUE 
XC  =  UH*TJ 

22  =  2I<J>  -  <VS21 00. 0>*<XC2UH> 

IF<22-2. 0)151, 151, 155 
CONTINUE 
22=2 . 0 
21=0.01 
GO  TO  160 
CONTINUE 

S1G2T  =  SIG2R*<<XC+QD>2XREF2>**2DIFF 

21  =  2I<  J)  -  1 .5*SIG2T 

1F<Z1 >159, 159,160 

CONTINUE 

21=0.01 

UBXJ  =  <U2/’‘<<22-21  )*C1  >>*<Z2**P-21**P> 

GO  TO  1000 

CONTINUE 

US=U2 

UH=US 

UBXJ=US 

CONTINUE 

UBXJ  =  SQRT<<UBXJ**2  +  UH**2>/2.0> 

IC  =  IC  ♦  1 

IF<  IC  .EQ. 1  >  UH  =  UBXJ 

IF< IC.EO. 1 >  GO  TO  50 

UBXB=UBX.J 

RETURN 

END 


UMEOOOi 0 

d****************/UME00020 
*.''UME0  0  030 
*/Up(E0  004  0 
*/UME00050 
*»»**************/UHt  0  0060 
UMEu0070 


UMEOOOSO 

UME00090 

UME001 00 

UME001 1 0 

UME00120 

UME00130 

UME00140 

UME00150 

UME00160 

UME00170 

UME00180 

UME00190 

UHE00200 

UME002i 0 

UME00220 

UME00230 

UME 00240 

UME002d0 

UME00260 

UME0U270 

UME00280 

UME00290 

UME 003 00 

UME0031 0 

UME00320 

UME00330 

UME00340 

UME00350 

UME00360 

UME00370 

UME 00380 

UME00390 

UME00400 

UME0041  0 

UME00420 

UME00430 

UME 00440 

UME00450 

UME00460 

UME00470 

UME00480 

UME00490 

UME00500 

UME0051 0 

UHE00520 

UME00530 

UME00540 
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SUBROUTINE  SUMr< X, Y, Z, NDIH > 

K  Di «  4s  *  H> « <k  «  »  *  Ik  *  >»:  *  ><<  >•<  >k  <•<  *  >(<  <•■ « ’k  <•<  Oi  *  >l>  ’K  >•< « Ik  « I*  «  4i  A  Ik  «  *  *  4t  *  «  «  «  Ki  4: 4i  4iil<  * 

SUBROUTINE  SUMR 
CRNAD  HODULE 
EOSRElBG 

k  sk  4i  4i  4i  4i  4<  4iik  Ik  4s  4i  4i  Ik  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4<  4i  4i  4i  4i  4i  4<  *  4<  4i  4i «  *  4i  4i  4i  4i «  4i  4i  4i  4i  4i  4i  k  4i  4i  4i  4i  Ik  4i 

PURPOSE! 

GENERAL  PURPOSE  INTEGRATION  SUBROUTINE 
USAGE: 

CALLED  FROM  GRNAD  TO  GET  INTEGRAL  OF  CONCENTRATION 
LINE-OF-SIGHT. 

DESCRIPTION  OF  PARAMETERS! 

X  INDEPENDENT  VARIABLE 

Y  DEPENDENT  VARIABLE 

2  INTEGRAL  OF  Y  OVER  X 

INDIM  NUMBER  OF  POINTS 

SUBROUTINES  AND  FUNCTION  SUBPROGRAMS  REQUIRED: 

NONE 

COMMON  BLOCK  STATEMENTS  REQUIRED: 

NONE 
REMARKS ' 

AS ‘used  by  grenade,  X  IS  POSITION  ONLIHE-OF-S ICHT , 
LOCAL  CONCENTRATION,  Z  IS  TOTAL  CONCENTRATION. 
METHOD: 

SUMA  INCREMENTS  INTEGRAL  BY  AVERAGE  OF  LAST  TWO  Y 
TIMES  DELTA  X. 

k  4s  Ik  4s  4i  Ik  4t  Ik  4(  41 4s  k  4s  k  4s  4i  4i  4*  4i  Ik  4i  Ik  Ik  Ik  4iik  4s  Ik  4i  4t  4s  4i  4s  4i  4i  4I  Ik  4t  4f  4i  41 4t  4*  4t  4s  4i  4*  4t  4t  41 4t  4<  k  4i  4s  4t 

DIMENSION  X< 1 000>,Y< 1 000>,2< 1000) 

SUM2  »  0.0 

IF  <NDIM  -  1  )  4,3,1 

kkk  INTEGRATION  LOOP  *** 

DO  2  I  -  2,NDIM 

SUM1  =  SUM2 

SUM2  =  SUM2  +  0.500*<X<I>-X<I-1  )>-k<Y<I>+Y<I- 

2<I-1>  =  SUMI 

Z<NDIM>  «  SUM2 

RETURN 
END 


♦  / 

♦  / 
♦  / 

ALONG 

*/ 

k/ 

>*•/ 

kX 

*/ 

*/ 

Y  IS  */ 
*/ 
*/ 

VALUES  4S/' 

*/ 

kkkkkkkkkk,-* 


VALUES 


SUMA001 0 
SUMA0020 
SUMA0030 
SUMA0040 
SUMA0050 
SUMA006C 
SUMA0070 
SUMAOOdO 
SUMA0090 
SUMA01 00 
SUMA01 1 0 
SUMA0120 
SUMA01 30 
3UMA0140 
SUMA01 50 
SUMAOIbO 
SUMA01 70 
SUMAOtSO 
SUMA01 90 
SUMA0200 
3UMA021 0 
SUMA0220 
SUMA 0230 
SUMA 0240 
SUMA0250 
SUMA0260 
SUMA0270 
SUMA0280 
SUMA0290 
SUMA0300 
SUMA031 0 
SUMA0320 
SUMA0330 
SUMA0340 
SUMA0350 
SUMA 0360 
SUMA0370 
SUMA 0380 
SUMA 0390 
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SUBROUTINE  LOCAT< I , X. Y, 2. XB , YB, ZB > 

C  /  til  >« )«( ^  4t  4i  .it  %  4t  Hi  ]|t  4i  41 %  %  4c  4t  4i  %  *  Hi  %  >li  4i  4i  111  4i  4>  4i  4t  %  %  *  %  4t  %  4t  %  *«(  I#  4c  limi  mUt  4i  4i  41  / 


C/*  SUBROUTINE  LOCRT  */ 

C/*  GRNAD  MODULE  */ 

C/’*  EOSAELdO  */ 

(j /'■)■*>•■<•■  »>XI  *<*  ii  >k  »■  <ti  >K  •  m  *  >k  «■  4i  ixti  <t>  «•>*  >k  >*  KOI' «•<*>•■■•<<»*»*•  If  41  *  Ik  4t  Hi  «*«  1)1  .(■«  :<i>ti  m  null  *  Ik  lO  It!  4i  / 

C/*  PURPOSE:  >¥/ 

C/*  LOCAT  TRANSLATES  POSITION  INTO  BURST  AND  WIND  COORDINATES, 

C/*  USAGE:  ix.^ 

C/*  CALLED  BV  CONCN  */ 

C/*  DESCRIPTION  OF  PARAMETERS!  */ 

C/K  T  TIME  <SECONDS>,  INPUT  */ 

C/*  X,Y,2  ORIGINAL  POSITION  <METERS).  INPUT  */ 

C/*  XI,YI,Z1  ORIGINAL  BURST  POSITION  <METERS).  INPUT  */ 

C/*  UDA  ANGLE  BETWEEN  WIND  VECTOR  AND  LINE  OF  SIGHT  */ 

C/*  <RADIANS>,  INPUT  */ 

C/*  XB,VB,ZB  TRANSLATED  POSITION  <METERS>,  OUTPUT  */ 

C/*  SUBROUTINES  AND  FUNCTION  SUBPROGRAMS  REQUIRED:  ■*/ 

C/*  NONE 

C/*  COMMON  BLOCK  STATEMENTS  REQUIRED:  */ 

C/*  MEChI  MECn2  */ 

C/*  REMARKS:  */ 

CV*  ORIGINAL  COORDINATES  HAVE  ORIGIN  AT  OBSERVER  AND  X-AXIS  */ 

C/*  THROUGH  TARGET,  NEW  COORDINATES  HAVE  ORIGIN  AT  BURST  */ 

C/f  AND  X-AXIS  IN  DIRECTION  OF  WIND  VECTOR.  */ 

C/*  HETHOO:  */ 

C/*  STANDARD  ROTATION  AND  TRANSLATION  OF  AXES  */ 


/  4i  4*  4i  4i  4i  4<  4i  4c  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4<  4*  4i  4i  4(  4i  4i  4i  4i  4i  4i  4>  4i  4i  4i  4>  4i  4i  4i  41 4i  4c  4i  4i  4i  4i  4i  4i  41 4t  4»  4i  4i  4i  4i  4i  4i  4i  4i  41 4c  4t  41  %  4i  4t  4i  4c  4t  / 

COMMOHXMECH1/'KI<  f  >,YI<  1  J,21<  i  >,TTI<  1  >,EMUN,BREXP 

C0MM0N/MECH2/U2. UDA. THETA, UBXB. QLENTH 

XB  =  <X  -XI<  1  ))4<C0S<UDA)  ♦  <Y-YI<  I  >>*S1N<UDA) 

YB  — <X-XI<  I  )>4.SIN<WDA;>  <Y  -  YI<  I  >)ikCOS<WDA> 

26=2 

IF<2B.LT.0.0.AND.ABS<2B>.GT.2I<I )>  2B=0.0 

RETURN 

END 


LOCOOOi 0 
LOC00020 
LOC00030 
LOC0D040 
LOCuCOSO 
LDC00060 
LOCOOuTu 
LOC 00 OB 0 
LOCOOOSO 
LOC001 00 
LOC001 1 0 
LOC00120 
LOC00130 
LOC00140 
LOC00150 
LOC00160 
LOC00170 
LOC00180 
LOCOOiSO 
LOC00200 
LOC0021 0 
LOC 002 20 
LOC00230 
LOC00240 
LOC00250 
LOC 00260 
LOC00270 
LOC00280 
LOC00290 
LOC00300 
LOC 0031 0 
LOC 00320 
LOC 00330 
LOC00340 
LOC00350 
LOC 00360 
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) 


00000000000000000000000000000000000000000000000000000000000000001 


SUBROUTINE  ONTkD<  I(JRIT>  IFLhG  > 

C/'*  SUBROUTINE  DATED  ♦ 

C/*  GRNAD  MODULE  • 

C/*  EOSAEL80  /* 

Q  /  %  %>»!  4ii|i  4i  %  4t  4t  i(i  9(t  i|t  %  4i  3|t  4«  41%  4i  %  4t  4i  «tt  4i  4i  %  ^  %  4*  %  4*  *  4t  )|t  %  %  it(  3(1 4>  %  4(  4i  %  4<  %  %  4(  )t(  %  94t  %  4i  %  >l(  %  *4i  ><(  4<  ><(  111  4( ’f' 

♦♦f**THIS  SUBROUTINE  READS  INPUT  DATA  IN  EXACTLY  THE  SAME  FORMAT  AS 
THE  SMOKE<EOSAEL  )  PROGRAM 
INPUTS 

EACH  CARD  BEGINS  WITH  A  4  LETTER  IDENTIFIER  IN  COL  )-4, 

FOLLOWED  BY  AS  MANY  (REAL)  FIELDS  AS  NEEDED,  10  COL. 

PER  FIELD  BEGINNING  IN  COL  11.  THE  CARDS  ARE  NOT  ORDER 
DEPENDENT. 

NAME  IGNORED 

BURN  IGNORED 

MUNC  XMiYM,ZM  COORDINATES  OF  GRENADE  FIRING  TANK 

HEAD  HEADING  OF  GRENADE  FIRING  TANK  CLOCKWISE 

FROM  NORTH 

RNG  GRENADE  FIRING  RANGE  OF  TANK 

OLEN  SPACING  OF  GRENADES  ALONG  LINE  PERPENDICULAR 

TO  HEADING 

OBSC  X0,Y0,20  COORDINATES  OF  THE  OBSERVER  <M,M,M) 

TARC  XT,YT,ZT  COORDINATES  OF  THE  TARGET  <M,M,M) 


XO, Y0,20 
XT, YT,ZT 

STO  STARTING  TIME  (ELAPSED  TIME  SINCE  BLAST) 

ETO  ENDING  TIME  FOR  CALCULATION 

DTO  TIME  INCREMENT  FOR  CALCULATION 

XNORTH  X  AXIS  HEADING  CLOCKWISE  FROM  NORTH 

XH  NUMBER  OF  MUNITIONS  FIRED  AT  THE  SAME 

LOCATION  AND  AT  THE  SAME  TIME 
FW  FILL  WEIGHT  >LeS > 

TBURN  BURN  TIME  OF  SMOKE  TYPE  (IGNORED) 

ITYPE  TYPE  OF  SMOKE  (DEFAULTS  TO  1) 

t.=WP,  2.=PWP,  3.=HC,  4.=F0G  OIL 
EFF  EFFICIENCY  OF  BURN  (PERCENT),  IF  0.0, 

DEFAULTS  TO  62 . OX . 

YF  YIELD  FACTOR  IF  0.0, DEFAULTS  TO  ANALYTICAL 

MODEL 

BRATE  EXPONENTIAL  BURN  RATE  PARAMETER 

RHA  RELATIVE  HUMIDITY  (PERCENT) 

UW  WIND  VELOCITY  (M-'S) 

WD  WIND  DIRECTION  (DEGREES) 

ICAT  PASQUILL  CATEGORY 

1-A,  2-B,  3-C,  4-D,  5-E,  6-F 
AIRT  SURFACE  AIR  TEMPERATURE  (IGNORED) 

TGRAO  VERT  TEMP  GRADIENT  (IGNORED) 

WPOWR  WIND  PROFILE  EXPONENT  (DIMENSIONLESS) 

DESIRED  CHANGES  IN  EXTINCTION  COEFF , 
(OPTIONAL).  IF  NOT  USED  OR  READ  AS  0. 
DEFAULTS  TO  ALPHA  ARRAY  VALUE  IN  STRNS . 
BANDS  ARE: 

0.4-0. 7  MICRONS 
0.7-i .2  MICRONS 
1.06  MICRONS 
3.0-5. 0  MICRONS 
8,0-12.  MICRONS 
10.6  MICRONS 
94 . 0  GHZ . 

DIFFUSION  PARAMETER  OPTION  CARD  FOR  GRNAD 
SICZR  DOWNWIND  REFERENCE  AT  100  M  REFERENCE  DIST. 

ZDIFF  VERTICAL  DIFFUSION  COEFFICIENT 

YDIFF  CROSSWIHO  DIFFUSION  COEFFICIENT 

HM  HEIGHT  OF  MIXING  LAYER  (METERS) 

HK  TERRAIN  SCAVENGING  COEFFICIENT 

RC  TERRAIN  REFLECTION  COEFFICIENT 

VS  SETTLING  VELOCITY  (CM  SEC) 

SIGNIFIES  END  OF  THIS  RUN,  BUT  NOT  END  OF  INPUT 
END  OF  JOB. 


FW 

TBURN 

ITYPE 


BRATE 


AIRT 

TGRAO 

WPOWR 


DAT  OOu 1 0 
/DAT00020 
.''DAT  00030 
/DAT  0  0 040 
/DAT 00 050 
/DATC0060 
DAT00070 
DAT  0  0 OB  0 
DAT  00090 
DAT  00100 
DAT001 1 0 
OAT00120 
DATOOl 30 
DAT001 4 0 
DAT  001 dO 
DATOOl 60 
DAT00170 
DAT00180 
DATOOl 90 
DAT  0  0200 
DATOOZi 0 
DAT00220 
DAT00230 
DAT00240 
DAT00230 
DAT00260 
DAT0027  0 
DA TO  0260 
DAT  0  029  0 
DAT  0  03 00 
DAT0031 0 
DAT  00320 
DAT00330 
DAT00340 
DAT00350 
DAT  0  036  0 
DAT00370 
DAT003S0 
DAT00390 
DAT  004 0  0 
DAT004 1 0 
DAT  0  042  0 
DAT00430 
DAT00440 
DAT00450 
DAT00460 
DAT00470 
DAT00480 
DATC1O49O 
DAT00500 
DAT0051 0 
DAT00520 
DAT  0  053  0 
DAT00540 
DAT  00550 
DAT  00560 
DAT 00570 
DAT  0058  0 
DAT00590 
DAT00600 
DAT006i 0 
DAT00620 
DATa0630 
DAT00640 
DAT00650 
DAT00660 
DAT00670 
DAT00680 
DAT00690 
DAT00700 
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(j ^  iK« «« 41 >4< * 4>i«i »»)•■*««>*•  i«t« >l<* «>)•  I*!* 4>W «ii* Id* OAT007  1  0 

COMMOH  /^lOUNIT/'IOlH,  lOOUT ,  IPHFUN ,  LOUNI T .  ND IRTU ,  NCL IMT .  KSTOR  ,  NPLOTUDAT 0 072 0 


COMMON  /GEOMET/PTS< 15), IGEOSU 

COMMON/CLYMPT/TEMP,PResS,RH, AH,DP, VIS,CLDAMT,CLOHYT,FOGPRB, 

♦  UINDVEL,UNDD1R,  IPPSCT 

COMMON/MECHO,'XM, YM,ZM,X0,Y0,20,XT,YT,2T, ISTO, lETO, IDTO,XN,FW, 
*TBURN, 1  TYPE, EFF,YF, RHP, UU,UD, ICAT,AIRT, TGRAD,BRftTE, HEAD, RNG, 

♦  DLEN, WPOWR, EXTC<  8 ), XMIS<  8 ), XNORTH 

DIMENSION  DUMY<  8  ), 1R< 26 ), 1R1 < 1 0 >, R 1 < 1 0 ) , EX< 7 ) , INAME< 35 ) 

DATA  IR/’2HME,2HTR,2HMU,2HNT,2HBA,2HRT,2HMU,2HNC,2H0B,2HSC,2HTA, 
faWRC , 2HEX , 2HTC , 2HBU , 2HRN , 2HM 1 , 2HSC , 2HG0 , 2H  , 2HD0 , 2HNE , 2HNA , 2HME , 
*2H0U,2HTP/ 

IF  <  IFLAG.GT. 0)  GO  TO  8 
DO  2  J=1 , 8 
XMIS<  J  >=0. 0 
2  EXTC<  J  )=0 . 

0t|| 

c***  BEGINNING  OF  READ  LOOP 

8  CONTINUE 

IF< IWRIT . EQ . 0  )GO  TO  6 
URITE< IOOUT,200) 

200  FORMAT<  1H0,21X,20H*>t<f**CARD  INPUTiof**-* ,  / , 21 X,  4 0<  2H"  >  ) 

201  F0RMAT<2A2,6X,35A2) 

202  FORMAT< 1H0,21X,2A2,6X,35A2) 

6  DO  70  1=1,13 

IF< I .EQ. 13)  GO  TO  310 
1F< IFLAG.GT. 0  )  GO  TO  4 
IFLAG=1 

READ< 10IN,201  )IR1< 1  ), 1R1 < 2 ), < INAMEC J >, J-1 , 35 ) 

IF< lURIT .EQ. 0)  GO  TO  4 

URITE<  IOOLIT,202  )IR1<  1  ),  IR1  <  2  ),  <  INAME<  J  ),  4“1 , 35  > 

4  READ<  IOIN,20)IR1<1),1R1<2),<R1<J),J*2,8) 

IF< lURIT.EQ. 0)  GO  TO  5 

WRITE< IOOUT,30>IR1< 1 ), IRl < 2 ), < Rl< J ), J»2, 8 ) 

5  IF< IR1< 1  ).EQ. IR<2t  ).AND. IR1<2).eQ. IR<22)>  GO  TO  998 
20  FORMAT<2A2,6X,7F10.3) 

30  FORMAT< 1H0,21X,2A2,6X,7F1 0,3) 

^ ^  ^ ^ 

C***  RELATING  INPUT  DATA  TO  VARIABLE  NAMES. 

^  i|r  J|(  }flr 

IF<  IRK  1  ).EQ.  IR<  1  ).  AND,  IR1<2).EQ.  IR<2))  GO  TO  90 
IF<  IRK  1  ).EQ.  IR<3).AND.  IR1<2).EQ.  IR<4))  GO  TO  100 
IF<  IRK  f  ).EQ.  IR<5>.  AND.  IRK2).EQ.  IR<6)>  GO  TO  110 
IF<IRK1  ).EQ.IR<7).AND.IRK2).EQ.IR<8))  GO  TO  120 
IF<  IRK  1  ).EQ.  IR<9).  AND,  IRK2).Ea.  IR<  1  0>>  GO  TO  130 
IF<  IRK  1  ).EQ.  IR<  1 1  ).AND.  IRK2>.EQ.  IR<  12>)  GO  TO  140 
IF<  IRK  1  ).EQ.  IR<  13).AND.  IR1<2>.EQ.  IR<  14>>  GO  TO  150 
IF<  IRK  1  ).EQ.  IR<  15).AND.  IRK2>.EQ.IR<  16>)  GO  TO  155 
IF<  IRK  1  ).EQ, 


GO  TO  90 
GO  TO  100 
GO  TO  1 1 0 
GO  TO  120 
GO  TO  130 


IF<  IRK  1  ).EQ.  IR<  15).AND.  IRK2>.EQ.IR<  16>)  GO  TO 
1F<  IRK  1  ).EQ.  IR<17).AND.  IR1<2>.EQ.  IR<  18>>  GO  TO 
IF<  IRK  1  ),EQ.  IR<  19).AND.  IRK2).EQ.IR<20>)  GO  TO 


IF<  IRK  1  ).EQ.  IR<21  >.  AND.  IRK  2) 
IF<  IRK  1  ).EQ.  IR<23).AND.  IR1<2) 
IF<  IRK  1  ),EQ.  IR<  25).  AND.  IRK  2) 

^  iff  IfUft  If!  ?fl 

C  ERROR  CAUTION  FOR  INVALID  DATA  CARD 

C 

IFLAG*2 

URITE<  lOOU".  ,  80) 

80  F0RMAT<21X,35H*****CAUTI0N***t<>*'  IHV 
GO  TO  70 

90  RHA  -  RK2) 

UW  =  RK3) 

WD  =  RK4> 

ICAT  -IFIX<RK5)) 

AIRT  -  RK6) 

TGRAD  =  RK7) 

UP0WR>RKd) 

GO  TO  70 

100  XN  -  RK2) 


IR1<2>.EQ.IR<22>)  GO  TO  998 
IRl<2).Ea.IR<24))  GO  TO  70 
IRK2>.EQ.  IR<26))  GO  TO  70 


INVALID  DATA  CARD) 


DAT00730 
OAT00740 
DAT00750 
DAT00760 
DAT00770 
DAT00780 
DAT00790 
DAT00800 
DAT0081 0 
DAT 00820 
DAT00830 
DAT 00840 
DAT00850 
DAT  0  086  0 
DAT0u870 
DAT008S0 
DAT00390 
DAT  0  09 00 
DAT  0  05 1  0 
DAT00920 
DAT00930 
DAT00940 
DAT00950 
DAT009e0 
DAT00970 
DAT00980 
DAT  00990 
DAT01 000 
DAT01 01 0 
DATOI 020 
DAT01 030 
DATOI 040 
DATOI 050 
DATOI 060 
DATOI 070 
DATOI 080 
DATOI 090 
DATOI 1 00 
DATOI 1 1 0 
DATOI 120 
DATOI 130 
DATOI 140 
DATOI 150 
DATOI 160 
DATOI 170 
DATOI 180 
DATOI 190 
DAT01200 
DAT0121 0 
DAT01220 
DAT01230 
DAT01240 
DAT01250 
DAT01260 
DAT01270 
DAT012e0 
DAT01290 
DAT01300 
DATOI 31 0 
DAT01320 
DAT01330 
DAT01340 
DAT01350 
DAT01360 
DAT01370 
DAT01380 
DAT01390 
DAT01400 
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FU 

=453 . 6*Ri <  3 ) 

TBURN 

=  Rl<4:) 

ITYPE 

=  IFIX<R1<5>> 

EFF 

=  R1<  6  ) 

yF=R1<7> 

BRATE= 

:R  1  <  8  > 

GO 

TO  70 

1  1  0 

I3TO 

=  IFIX<R1<2>> 

lETO 

=  IFIX<R1<3)> 

IDTO 

=  IF1X<R1<4)> 

XNORTH=  R1<5> 

IF< ISTO .LE . 0)ISTO=1 

GO 

TO  70 

120 

XM 

=  R1<2) 

yM 

=  R1<3j 

ZM 

=  R1<4> 

HEAD 

=  Rl<5> 

RNG 

=  R1<6) 

DLEN 

=  R1<7> 

GO 

TO  70 

130 

XO 

=  Rt<  2  ) 

YO 

-  R1<3) 

zO 

=  R1 <  4  > 

GO 

TO  70 

140 

XT 

*  K  1  (  2  ) 

YT 

=  Ri<3> 

2T 

=  R1<4j 

}f(  9^  9^  Sfc 

C4>«>t<*>i<6URN  CARD  DATA  DUHHVED  BV  PROGRAM  CRHAD***** 

QiKi|i4ii«t« 

155  DO  156  J=l,7 

156  OUMYC  0  )«=R1<  J+1  ) 

GO  TO  70 

150  DO  152  J»1,7 

152  EXTC< J)=R1< J+1  ) 

GO  TO  70 

165  DO  166  J=«1,7 

166  XMIS< J)«R1< J+1  ) 

70  CONTINUE 

175  GO  TO  31 1 

^  9^  l|f  9^  pfl 

C*****CAUTION  FOR  TOO  MANY  CARDS 

^*3’l'o’*WRITE<  IOOLIT,320) 

IFLAG=3 


DAT  01410 
DAT01420 
DAT01430 
DAT01440 
DAT01450 
DAT01460 
DAT01470 
DAT  01 480 
DAT01490 
DAT01500 
DAT  01510 
DAT 01 520 
DAT01530 
DAT 01 540 
DAT  01550 
DAT01 560 
DAT01570 
DAT015S0 
DAT01 590 
DAT01600 
DAT  01610 
DAT01620 
DAT01 630 
DAT 01 640 
DAT  01650 
DAT01660 
DAT01670 
DAT01680 
DAT01 690 
DAT01700 
DAT01710 
DAT01720 
DAT01730 
DAT01740 
DATD1750 
DATOl 760 
DAT01770 
DAT01780 
DAT01790 
DAT01800 
DAT0181 0 
DAT01820 
DAT  01830 
DAT 01 840 
DAT01850 


C**^*:i.DEFAULT  non  user  defined  input***** 

31 1  IF< ITYPE.EQ. 1 )GO  TO  3 
ITYPE=1 

URITE< lOOUT, 171  ) 

171  FORMAT<1H  , 2 1 X , 1 7H*****CAUT ION***** . 7 , 1 H  , 21 X , 54HWR0HC  SMOKE  TYPE 
*FOR  PROGRAM  GRNAD--DEFAULTED  TO  HP/RP> 

3  IF<EFF.EQ.0.0>EFF=62.0 

IF<  YF , EQ . 0 . 0  >YF=3 .14+0. 032*RHA 
IF<EXTC< 1 ).GT.O,0)GO  TO  1 
CALL  EXTlNiEX) 

DO  7  1=' ,7 
7  EXTC< I )=EX<  I  ) 

1  CONTINUE 

32  0  FORMAT<  2 1 X , 1 7H*****C AUT I ON***** , 7 , 

*21X,56HM0RE  THAN  10  DATA  CARDS  ENTERED — REMAINING  CARDS  IGNORED) 
GO  TO  9999 
998  IFLAG=4 

9999  IF<:iGEOSU.NE.  1  >  GO  TO  555 
DISKTM=1 000. 

C***  CONVERT  KM  TO  M. 

XT»PT8< 1 >*DISKTM 
YT*PTS<2>*DISKTM 
2T*=PTS<3>*DISKTM 


DAT01860 
DAT01870 
DAT01880 
DAT0189G 
DAT01900 
DATOl 91 0 
DAT01920 
DAT01930 
DAT01940 
DAT01950 
DAT  01 960 
DAT01970 
DAT01980 
DAT01990 
DAT 02000 
DAT0201 0 
DAT02020 
DAT02030 
DAT02040 
DAT 02 050 


DAT02060 
DAT 02 070 
OAT02080 


r 
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M 


X0=»PTS<4)i*DlSKTM  DrtT02090 

Y0»PTS<5)-»DISKTM  DAT02100 

20=PTS<6>*D13i<TM  DAT02110 

555  RETURN  ORT02120 

END  DHT02130 


i 


bUBRuUTIHE  LT4M<:h1  ,H2,HHbLE,  ITyPE,  I  ?<V ,  TkhN  ,  RhD  A ,  RhCjG  .  lEMISS.LEN,  L4i*l0001  0 
+  MODEL, VIS, VI 1 , V22, T1 , ICLMAT, lERR^NR, IHA2E.MULDV  >  L4M0  0020 

LOGICAL  ISPOT, LOREAD, N1 6  L4M00030 

COMMON  /C0NST,'PI,PI2,CA,TU0PI,T0RRMB,CDEGK.  L4M00040 

COMMON  .-'MOI.-'EHC  1  6 , 34  > ,  P<  34  > ,  T<  34  > ,  UH<  34  ) ,  Z<  34  > ,  WAC  34  > ,  RE  ,  M ,  NL  L4M0  005  0 

COMMON  /M02,'  WO<  34  ) ,  RO ,  T80UND ,  JP ,  IM ,  ML  ,  IP ,  JSTOR  L4M00060 

COMMON  /MOS/  C1<501  ),C2<258>.C3<86>,C4(33>.C5<6  >,C5DUM(9),C8<82>,  L4M00070 
1  Cl  1<4),C12<  15>,C14C2I  >,C15<6>  L4M00080 

COMMON  .>'M07/’TR<67),FU<67),F0<67>  L4M00090 

COMMON  /'M08/'SUM4,  SUMS,  SUMS,  SUM H  ,  SUMS  L4MOOIOO 

COMMON  /M09/RADMAX,RADMIH, VRMAX, VRMIN  L4M00110 

COMMON  XMOS/  FS<9>,SK9>,S2<9>,FNH3<9>,FH1<9>,FH2':9),FN02<9>,  L4M00120 

1  01<9>,02<9>,PPMS02,PPMNH3,PPMH02  L4M00130 

COMMON  XIOUNITXIOIN, lOOUT, IPHFUN , LOUNIT , ND IRTU , NCL I MT , KSTOR , NPL0TUL4M 0 0 1 40 
COMMON  /LOUEX/'UIPATH<  68,  1  6  ) ,  UILAY<  34 ,  1  6  ),  TBBY<  68  >,  TX<  16>,BETAEX,  L4M00150 
1  CLDHGT,NCLD  L4M00160 

COMMON  /EM1.-'HMIN,KMAX,  1  J,  J1  ,  J2,  JMIN,  JEXTRA,NP1  L4M00170 

COMMON  /EM2XW< 16  ),E( 1 6  ), IL, IKMAX,LENTOR,NLL  L4M00I80 

COMMON  /’BASPOTX  ANG<  65  ) ,  SUM<  65  ) ,  UVL<  1 6  ) ,  NWVL ,  ALBB<  1 6  ) ,  BSO  6  >,  L4M00190 

1  BE< 16>,S1NGWV,PF<65),LMAX  L4M00200 

COMMON  /3P0TL0,'ISP0T,L0READ,H16  L4M002t0 

DIMENSION  TRAN<16)  L4Mn0220 

DIMENSION  RADA< 1 6 >, RhOO(  1 6 )  L4M0025O 

C  PLANCK  RADIANCE  FUNCTION  .  L4M00240 

FF<  T ,  V  )=  1  .1  9  0956E-  i  ')/<  EXP<  i  .  43879‘»V2T  >-i.)  L4M0u250 

C  WATT  CM-2  ST-1  MICROH-1  L4M00260 

c  I|I  iX  Hi  W  « »  »I  IK  >)| «  «  4<  >X  «  «  W  «  « « >0  «  «  4<  «■  4<  %  >*  >•> 'll  <<■ ‘K  *  W  *  ^  >tt  HI  1)1 « :f  « >|c « '4! « if  sti '4i  L  4  M  0  0 2  8  0 

C  L4M00290 

C  PROGRAM  MODIFIED  LOUTRAN  CALCULATES  THE  TRANSMITTANCE  L4M00300 

C  OF  THE  ATMOSPHERE  FROM  830  TO  1250,  2010  TO  3330,  AND  L4M00310 

C  5010  TO  39990  CM-1  <0,25  TO  2. 0,3.0  TO  5.0, AND  8.0  TO  12.0  L4M00320 

C  MICRONS)  AT  20  CM-1  SPECTRAL  INTERVALS  ON  A  LINEAR  WAVENUMBER  L4M00330 

C  SCALE.  L4M00340 

C  REFRACTION  AND  EARTH  CURVATURE  EFFECTS  ARE  EXCLUDED.  ATMOSPHERE  L4M00350 

C  IS  LAYERED  IN  ONE  KM  INTERVALS  BETWEEN  0  AND  25  KM,  5  KM  INTER-  L4M00360 

C  VALS  FROM  25  TO  50  KM,  A  20  KM  LAYER  FROM  50  TO  70  KM,  A  30  KM  L4M00370 

C  LAYER  FROM  70  TO  100  KM,  AND  ONE  FROM  100  KM  TO  INFINITY.  L4M00380 


PROGRAM  ACTIVATED  BY  SUBMISSION  OF  CARD  SEQUENCE  AS  FOLLOWS  L4Mu0400 

L4MCi041  0 

CARD  1  MODEL, IHA2E, ITYPE,LEN, JP,HPLT, IM, ML, lEMISS,  L4M00420 

RO,TBOUND,BETAEX  FORMAT  <  9I3,3F10,3>  L4M00430 

MODEL  =0, METEOROLOGICAL  DATA  SPECIFIED  L4M00440 

=1, TROPICAL  MODEL  ATMOSPHERE  L4M00450 

-2,MIDLATITU0E  SUMMER  L4M00460 

“3, MIDLATITUDE  WINTER  L4M00470 

=4, SUBARCTIC  SUMMER  L4M00480 

=5, SUBARCTIC  WINTER  L4M00490 

*6,1962  US  STANDARD  L4MCi0500 

*7, NEW  MODEL  ATMOSPHERE  L4M00510 

=8, ISRAELI  STANDARD  ATMOSPHERE  (YEAR,  DAYTIME)  L4M00520 

=9, ISRAELI  STANDARD  ATMOSPHERE  (YEAR,  NIGHTTIME)  L4M00530 

•*  AEROSOL  ATTENUATION  LIMITED  TO  4  KM  BASE  HEIGHT  AND  500  M  THICK  ffL4M00540 
FOR  SLANT  PATHS  IHA2E  =  1,2,  OR  3  ARE  THE  ONLY  ALLOWED  VALUES.  L4M00550 
IHA2E  =0,NO  AEROSOL  ATTENUATION  L4M00560 

■1,  MARITIME  POLAR  L4M00570 

■2,  MARITIME  ARCTIC  L4M00580 

*3,  CONTINENTAL  POLAR  L4M00590 

«4,  RAIN  L4M00600 

*5,  SNOW  L4M00610 

*7,  USER  SUPPLIED  EXTINCTION  COEFFICIENT  L4M00620 

(READ  ON  ATM  CARD  -  SEE  CARD  3  BELOW)  L4M00630 

ITYPE  »1 .HORIZONTAL  (CONSTANT  PRESSURE)  PATH  L4M00640 

=2, VERTICAL  OR  SLANT  PATH  BETWEEN  2  ALTITUDES  L4M00650 

-3, VERTICAL  OR  SLANT  PATH  TO  SPACE  L4M00660 

LEN  -0, NORMAL  OPERATION  L4M00670 

=1, DOWNWARD  LONG  PATH  L4M00680 

JP  *0, NORMAL  OPERATION  L4I100690 

-1, SUPPRESS  PRINT  OF  H0RI2  AND  VERTICAL  PROFILES  L4M00700 

NPLT  -0,  NORMAL  OPERATION  L4M0071 0 


( 


0000000000000000000000000000000000000000000000000000 


*1,  IN  TRANSMISSION  MODE  WRITE,  WAVELENGTH  tUM),  L4M00720 

H20,  C02+,  OZONE,  N2  C,  M20  C,  MOL  SCAT,  L4M00730 

NITRIC,  S02,  HN03,  N02 .  IN  EMISSION  MODE  L4M00740 

WRITE  WAVELENGTH  < UM >  AND  RADIANCE  PER  MICRON.  L4M00750 
RESULTS  WILL  BE  WRITTEN  ON  NPLOTU  < SEE  COMMON  BLOCK  lOUNlT;  L4MOu760 
IM  =1 , RADIOSONDE  DATA  TO  BE  READ  INITIALLV  L4M00770 

*0, NORMAL  OPERATION  OR  WHEN  SUBSEQUENT  CALCULATIONS  L4M00780 
ARE  TO  BE  RUN  WITH  MODEL  =  7  L4M00790 

ML  *NUMBtR  OF  LEVELS  TO  BE  READ  IN  FOR  MODEL  =  7  L4M0080U 

•  >»*IM  AND  ML  ONLY  USED  WHEN  MODEL  =  7  AND  THEN  ONLY  ON  L4M0081  0 

FIRST  CALCULATIONS  WHEN  DATA  READ  IN  L4M00820 

lEMISS  DETERMINES  MODE  OF  EXECUTION  OF  PROGRAM  L4M00830 

=0, TRANSMITTANCE  MODE  L4M00840 

=1, RADIANCE  MODE  L4M00850 

RO  RADIUS  OF  THE  EARTH  < KM )  AT  LOCATION  OF  CALCULATION  L4M00860 

♦♦♦DEFAULT  WILL  BE  MIDLATITUDE  VALUE  OF  6371.23  KM  WHEN  L4M00870 

MODEL  =  0  OR  =  7  OTHERWISE  DEFAULT  IS  EARTH  RADIUSL4M00S80 
FOR  STANDARD  MODEL  ATMOSPHERE  SPECIFIED  BY  MODEL  L4M00890 
TBOUHD  TEMPERATURE  OF  EARTH  <DEGREES  K  ;>  AT  LOCATION  OF  CALCUL4H00900 
♦♦♦USED  ONLY  IN  RADIANCE  MODE  FOR  SLANT  PATHS  WHICH  INTERSECT  EARTH  L4M00910 
♦♦♦DEFAULT  IS  TEMPERATURfc  OF  hIRST  LAYER  BOUNDARY  TtMPERATURE  L4M00920 
BETAEX  USER  SUPPLIED  EXTINCTION  COEFFICIENT,  INPUT  ONLY  L4H00930 

WHEN  IHAZE=7  L4M00940 

CARD  2  HI ,H2, ANGLE, RANGE, BETA, VIS, CLDHGT  FORMAT  <7Ft0.3>  L4M00950 

HI  INITIAL  ALTITUDE  < KM >  L4M00960 

H2  FINAL  ALTITUDE  <KM)  L4M00970 

ANGLE  INITIAL  ZENITH  ANGLE  <  DEG  >  l4M0Ci980 

RANGE  PATH  LENGTH  < KM )  L4M00990 

BETA  EARTH  CENTER  ANGLE  SUBTENDED  BY  HI  AND  H2  cDEG>  L4M01000 

VIS  SEA  LEVEL  VISUAL  RANGE  <:KM>  L4M01010 

CLDHGT  HEIGHT  OF  BOTTOM  OF  CLOUD  LAYER  CKM),  WHEN  IHAZE  NE  0L4M01020 

♦♦♦VIS  NOT  REQUIRED  ON  THIS  CARD  IF  ICLMAT  CEOMAIN)  *1  OR  L4M01 030 

♦♦♦THIS  IS  FIRST  LOOP  THROUGH  LT4  L4M01040 

♦♦♦SEE  MANUAL  FOR  MORE  DETAIL  L4M0iO5O 

CARD  2A  V1,V2,MULDV  FORMAT  <2F10.3,12>  L4M01 060 

VI  INITIAL  FREQUENCY  <CM^^-1)  L4M01070 

V2  FINAL  FREQUENCY  <CM»^-1)  L4M0i080 

MULDV  MULTIPLIER  FOR  FREQUENCY  INCREMENT,  WHERE  THE  L4M0t09C 

INCREMENT  IS  A  MULTIPLE  OF  20  <CM*^-1>.  L4M01100 

OPTIONAL  CAROS  FOR  RESPONSE  FUNTION  < SET  BY  NR«1  IN  EOMAIN)  L4M01110 

CARD  1)  NUMBER  OF  VALUES  FOR  RESPONSE  FUNCTION  -  FORMAT  <I2>.  L4M01t20 

CAROS  2  -  NUMBER  OF  VALUES:  FORMAT  < 2< El  0 . 4 , 1 X > >  L4M01130 

ONE  VALUE  OF  WAVELENGTH  <UM)  AND  RESPONSE  FUNCTON  PER  CARD  L4M01140 

CARD  3  IXY  FORMAT  <13)  L4M01150 

IXY  =0,EXIT  LOWTRAN  MODULE  L4M0tl60 

=  1, SELECT  NEW  WAVE  FREQUENCY  RANGE  <  CARD  2A  >  L4M0n70 

=2, SELECT  NEW  DATA  SEQUENCE  <CARDS  1,2,2A,3)  L4M01180 

=  3,  SELECT  NEW  CARD  2  AND  CARD  3  L4M0n90 

♦4, SELECT  NEW  CARD  1  AND  CARD  3  L4M01200 

L4M0121 0 

♦♦♦FOR  HON-STANDARD  CONDITIONS  SEE  MANUAL  L4M01220 

♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦ ♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦4i^ «♦♦♦♦♦ ♦♦♦♦♦♦♦♦♦♦♦♦♦♦L4M0 1230 
Vl-Vll  L4M01240 

V2*V22  L4M01250 

KMAX=16  L4M01260 

I3POT1=0  L4M01270 

RESPFN=0,  L4M012S0 

SUMRPF>=0.  L4M01290 

3UMINT=0.  L4M0f300 

IF  <ISPOT)  NPLT-0  L4M01310 

200  CONTINUE  L4M01320 

IF  < ,NOT.LOREAD>  GO  TO  400  L4M01330 

LOREADs. FALSE.  L4M01340 

READ  <LOUNIT.3300)  IATM,NL  L4M01350 

NL4-4^NL  L4M01360 

DO  299  I«1,NL4  L4M01370 

299  READ  < LOUNIT, 3500 >  DUMMY  L4M01380 

READ  <L0UN1T,351 0>  PPMS02 , PPMNH3 . PPMN02  L4M01390 

READ  <LOUHIT,3700><TR<  1  >,FW<  1  ),F0<  I  ),I-1,67>  L4M01400 

READ  <LOUN1T,3800)<C1<  I  >,  1=*1 ,501  )  L4M01410 


♦♦♦DEFAULT  IS  TEMPERATURfc  OF  hIRST  LAYER  BOUNDARY  TfcMPERATURE 
BETAEX  USER  SUPPLIED  EXTINCTION  COEFFICIENT,  INPUT  ONLY 
WHEN  IHAZE=7 

;ARD  2  HI ,H2, ANGLE, RANGE, BETA, VIS, CLDHGT  FORMAT  <7F10.3> 

HI  INITIAL  ALTITUDE  < KM > 

H2  FINAL  ALTITUDE  <KM) 

ANGLE  INITIAL  ZENITH  ANGLE  < DEG > 

RANGE  PATH  LENGTH  < KM ) 

BETA  EARTH  CENTER  ANGLE  SUBTENDED  BY  HI  AND  H2  cDEG> 

VIS  SEA  LEVEL  VISUAL  RANGE  <:KM> 

CLDHGT  HEIGHT  OF  BOTTOM  OF  CLOUD  LAYER  CKM),  WHEN  IHAZE  NE 
♦♦♦VIS  NOT  REQUIRED  ON  THIS  CARD  IF  ICLMAT  CEOMAIN)  *1  OR 
♦♦♦THIS  IS  FIRST  LOOP  THROUGH  LT4 
♦♦♦SEE  MANUAL  FOR  MORE  DETAIL 
:ARD  2A  VI, V2, MULDV  FORMAT  <2F10.3,I2> 


CARD  2A  VI, V2, MULDV  FORMAT  <2F10.3,I2> 

VI  INITIAL  FREQUENCY  <CM^^-1) 

V2  FINAL  FREQUENCY  <CM»^-1) 

MULDV  MULTIPLIER  FOR  FREQUENCY  INCREMENT,  WHERE  THE 

INCREMENT  IS  A  MULTIPLE  OF  20  <CM*^-1>. 

OPTIONAL  CARDS  FOR  RESPONSE  FUNTION  < SET  BY  NR«1  IN  EOMAIN) 

CARD  1)  NUMBER  OF  VALUES  FOR  RESPONSE  FUNCTION  -  FORMAT  <I2). 
CAROS  2  -  NUMBER  OF  VALUES:  FORMAT  < 2< El  0 . 4 , 1 X  )  > 

ONE  VALUE  OF  WAVELENGTH  <UM)  AND  RESPONSE  FUNCTON  PER  CARD 
CARD  3  IXY  FORMAT  < 13) 

IXY  =0,EXIT  LOWTRAN  MODULE 

=1, SELECT  NEW  WAVE  FREQUENCY  RANGE  < CARD  2A > 

=2, SELECT  NEW  DATA  SEQUENCE  < CARDS  1,2,2A,3) 

=3, SELECT  NEW  CARD  2  AND  CARD  3 
♦4, SELECT  NEW  CARD  1  AND  CARD  3 
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REhD  <LOUNIT,38CiOj<C2<  I  '} .  I»1  ,258> 

READ  <LOLINIT,3800><C3<  I  I»1 ,86> 

READ  <LOUNIT,3900)<C4< I  l  =  t ,33> 

READ<  LOUNIT, 381 0  K  C5< I  ), 1-1 ,6  ) 

READ  <L0UNIT,39C0><C8< I Z-1 ,82) 

READ  <LOUNJT,4000)<C1 1< 1 ), 1=1 ,4) 

READ  <LOUN1T,4  01 0)<C12< 1  ), 1  =  1 , 15) 

READ  < LOUNIT, 4020)CC14< I ), 1=1 ,21 ) 

READ  <LOUNIT,4020)<C15< I  ), 1-1 ,6) 

READ  <L0UNIT,401 0)<FS< 1 ),S1< 1 >,S2< 1 ), 1=1 ,9) 

READ  <LOUHIT,401 0)<FNH3< 1 ).FH1< 1  ),FH2< 1 ), 1  =  1  .9) 

READ  <LOUHIT,4  01 0 )<FH02< I ) , 0 1 < I ), 02< 1 > , 1  =  1 , 9  ) 

REWIND  LOUNIT 
IF  CiSPOT)  GO  TO  710 

400  CALL  CiCtK  (  vi  ,  V2 ,  Dv ,  I V 1  ,  I v2 ,  lOV,  IEkk,  MULDv,  ISFOT,  <  KAN'i  f  >  ) 
IF  < lERR ,EQ,  t  )  RETURN 
Jp  =  U 


JST0R=0 

.NOT.  ISPOT)  GO  TO  700 
BETA=0 . 

RANGE=0 . 

Ru=0  . 

IF  < I  TYPE. EG. 1)  RANGE-ANGLE 
IF  <I>iY.EG.0)  GO  TO  700 
401  GO  TO  <500,700,600,680), IXY 
500  AVU=t .E+04/V1 
ALAM  =  1  .E+04,''V2 
SUriA=0 . 

GO  TO  1 1 00 

600  IF  < MODEL . EG . 0  )  GO  TO  800 
ISP0T1-1 
GO  TO  1000 
700  CONTINUE. 

680  If”< .NOtf ISPOT)  READ  <IOIN,3300>  MODEL, IHA2E, ITYPE, 

1  LEN, JP,NPLT, IM,ML, IEMlSS,RO, TBOUND 
C*****IEM1SS-0«TRANSMISSION  mode  /  lEMlSS-l-EMISSIOH  MODE 

IF  << 1EMIS3.EQ. 1  ).AND.<  .NOT.ISPOT))  WRITE  <100UT.4100) 

IF  << lEMlSS. EG. 0). AND. <  .NOT.ISPOT))  WRITE  <10007,4200) 

IF  < ISPOT)  GO  TO  800 

IF<MODEL.EQ. O.OR.MODEL.EQ.?)  GO  TO  210 
71 0  READ<LOUNIT,33uO>IATM,NL 
MSKIP=<nODEL-1 )/2 
IF<MS(<IP.EG,  0)  GO  TO  220 
IF  <MSKIP.EQ.4)  MSLIP=5 
DO  230  J=1 ,MSKIP 
DO  230  1=1 ,NL 

230  READ< LOUNIT, 3500)  DUMMY 
220  CONTINUE 

C  ISRAELI  STD  ATM  READS 

IF  <M0DEL,EQ,8)  GO  TO  270 
IF  <M0DEL.EG.9)  GO  TO  250 
IF  <2-< MODEL/2), EG, MODEL)  GO  TO  250 
270  DO  240  1=1, NL 

24  0  ReAD< LOUNIT,  3500.)Z<  I  ),P<  I  ),  T<  I  ),WA<  1  ),WH<  I  >,WO<  I  ) 

GO  TO  21 0 
250  DO  26  0  ’  =  1  ,NL 

260  READ<LOUNIT, 3550)Z< I ),P< I ),T< I >,UA< I >,WH< I >,WO< I > 

210  REWIND  LOUNIT 

IF  < ISPOT)  RETURN 
800  M-MODEL 

900  IF  <RO,GT. 0)  RE-RO 
LENTOR-LEN 

1 000  CALL  ABSORe< IXV, IERR,«, VI ,V2,DV,SUMA,MULDV, ANGLE, LEN, ITYPE, HI ,H2, 
1  MODEL, ISPOTl , RANGE, BETA, VIS, I CLMAT, IVl , IV2, IDV) 

IF  < lERR.EO. 1 >  TRAN< 1 >-l , 

IF  <  lERR.EG. 1 >  RETURN 
1 1 00  CONTINUE 

IF  <. NOT. ISPOT)  WRITE  <IOOUT,4300> 


L4M01 420 
U4M01 430 
L4M0144C 
L4M0t450 
L4M01 460 
L4M01 470 
L4M01480 
L4M01 490 
L4M01500 
L4M0151 0 
L4M01520 
L4M01530 
L4M01540 
L4M01550 
L4M0i 560 
L4M01570 
L4M0 1 580 
L4M01590 
L4nCi bOO 
L4M01 61 0 
L4M01 620 
L4M01 630 
L4M01 640 
L4M01650 
L4M01 660 
L4M0f 670 
L4M01 680 
L4M01 690 
L4M017o0 
L4M0171 0 
L4M01 720 
L4M01730 
L4M0i 740 
L4M01750 
L4M01 760 
L4M0I770 
L4M0178CI 
L4M01790 
L4M0iS00 
L4M0181 0 
L4M01820 
L4M01830 
L4M0184U 
L4M01850 
L4M01 860 
L4M01870 
L4M01 880 
L4M01890 
L4M01900 
L4M0191 0 
L4M01920 
L4M01930 
L4M01 940 
L4M01950 
L4M01 960 
L4M01970 
L4M01980 
L4M01990 
L4M02000 
L4M0201 0 
L4M02020 
L4M0203CI 
L4M02040 
L4M02050 
L4M02060 
L4N02070 
L4M02080 
L4M02090 
L4H021 00 
L4M021 1 0 
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IF  <  .NOT  ,  ISPOT  >  URITEc  IOOUT,4400>  <  ii«  I  ),  1  =  1 , 6  >,  Wi  8  uH  1  0  > 

IF  <, NOT. ISPOT)  UIRITE<  IO0UT,4401  ) 

IF  <, NOT. ISPOT)  WRITE  <IOOUT,4500)  U( 11  ), U(1 2 >, U< 1 3  )  . U< 1 4  ) , 

*  UK.  1S>,UK16) 

1200  CONTINUE 

C  NCLO  WILL  BE  THE  INDEX  OF  THE  LAYER  ABOVE  CLDHCT 

DO  5  ICLD  =  i',b 
NCLD=ICLD 

IF  <CLDHGT.LT.2< ICLD>)  GO  TO  b 

5  CONTINUE 

b  CONTINUt 

IF  <CLDHGT.GT.2<6))  WRITE  <I00UT,7> 

7  FORHAT  <1H  ,25H***>*>  WARNING  FROM  LOWTRAN ,  7 ,  1  X ,  1  4HC  LOUD  BASE  IS 

1  23HL1MITED  TO  4  KM  MAXIMUM7) 
i  =  t 
L=1 

IV=IV1 

ICOUNT=0 

IF  <Nlb>  KWAVE=U 

IF  < lEMISS.EQ, 0>  GO  TO  1300 

RAD'5UM=0 . 0 

FACTOR=0 . 5 

CALL  LTPATHt ULAY.WPATH.TBBY, ANGLE AtH, ITYPE, Hi .H2. MODEL) 

IF  <. NOT. ISPOT)  WRITE  <IOOUT.4600> 


LOOP  OVER  LAYERS  FOR  EMISSION 


IF  <. NOT. ISPOT)  WRITE  < I OOUT , 470 0 > 

BEGINNING  OF  TRANSMITTANCE  CALCULATIONS 
1300  CONTINUE 

IF  <N16>  KWAVE-KWAVE+1 
SUMV=0. 

TLOLD=t . 

TSOLD=1 , 

TX7=1 . 

TX1 0=1 , 

IKLO=1 

T(jrL&=l 

IF  < lEMISS.EQ, 0)  IKMAX=IKLO 

;  ONLY  ONE  LOOP  FOR  TRANSMISSION*.  LOOP  OVER  LAYERS  FOR  EMISSIC 
DO  2300  IK=IKLO. IKMAX 
IF  < lEMISS.EQ. 0)  GO  TO  1500 

;  TRANSFER  CUMULATIVE  ABSORBER  AMOUNTS  FOR  TH  IK  TH  LEVEL  AND 

;  THE  K  TH  ABSORBER  -  EMISSION  ONLY. 

DO  1400  K=1 ,KMAX 
U(K)=WPATH< IK,K) 

1400  CONTINUE 
1500  IJ=IK 

IF  <  ICOUNT .EQ. 0)  GO  TO  1600 
IF  < ICOUNT. EQ. 50)  GO  TO  1600 
GO  TO  1700 
1600  ICOUNT=0 

IF  <<  lEMISS.EQ. 0>. AND. <  .NOT. ISPOT))  WRITE  <IOOUT.4800> 

1700  DO  1800  K®1 ,KMAX 
TX<K)=1  .  0 
1800  CONTINUE 

ICOUNT=ICOUNT+1 
V=FLOAT< IV) 

ALAM=1 .E+047V 
I=< IV-830)/20+l 
SUM4=0, 

SUM5=0, 

SUM6=0, 

SUM8=0, 

SUM1 1-0, 

CALL  FREQSL< I, IViW/TX) 

TX<  9  )=SUM4+SUM5+SUM8+SUM1 1 +SUM6 
IF  < TX< 8  ) . EQ . 0 . 0  )  GO  TO  2000 
IF  <TX<9  ).LE. 0. 1  )  CO  TO  1900 
IF  <:TX<9>.GT.20,  >  GO  TO  2100 
TX<9>-EXP<-TX<9)> 

GO  TO  2200 

1900  TX<9)«1  ,  0-TX<9)+0.5*TX<9>*TX<9> 


1600 
)  1600 


L4M021 20 
L4MCt2t30 
L4M02140 
L4M02150 
L4M02160 
L  4  M  0  2 1  7  0 
L4M02 180 
L4M021 90 
L4M02200 
L4M0221 0 
L4M02220 
L4M02230 
L4M02240 
L4M02250 
L4M02260 
L4M02270 
L4M02280 
L4M02290 
L4M02300 
L4M0231 0 
L4M02320 
L4M02330 
L4M02340 


L4M02350 
L4M02360 
L4M02370 
L4M023SO 
L4M 02390 
L4M02400 
L4M0241 0 
L4M02420 
L4M02430 
L4M02440 
L4M02450 
L4M02460 
L4M02470 
L4M02480 
L4M02490 
L4M02500 
L4M0251 0 
L4M02520 
L4M02530 
L4M02540 
L4M02550 
L4M02560 
L4M02570 
L4M025S0 
L4M02590 
L4M02600 
L4M0261 0 
L4M02620 
L4M02630 
L4M02640 
L4M02650 
L4M02660 
L4M 02670 
L4M026d0 
L4M02690 
L4M02700 
L4M0271 0 
L4M02720 
L4M02730 
L4M02740 
L4M02750 
L4M02760 
L4M02770 
L4M027d0 
L4M02790 
L4M02d00 
L4M0281 0 
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no  ooo 


GO  TO  2200 
2  00  0  TX<  9  >=1  ,  0 
GO  TO  2200 
2100  TX<9  )=Q , 

220  0  TX<9  ;  =  TX<  i  ;*TX<:  2  j*TX<  3  )*TX<9)-»TX<  12  >-*TX(  1  3  )’*TX(  14  > 

C  AEROSOL  computations  UNTIL  LABEL  1 

IF  < IHAZE.EQ. 0.0ft. IK,HE,(NCLO-1 >>  GO  TO  1 

IF  SPOT  IS  CALLING  LT4M  WITH  ITYPE  =  3,  DO  NOT  INCLUDE  AEROSOLS 

IF  < ISPOT. AND. ITYPE. EQ. 30  GO  TO  1 
EXT55=3. 9M/VIS 

UPPER  LIMIT  OF  500  METERS  VERTICAL  DISTANCE  FOR  X3CALE 
PASS  HORIZONTAL  DIST  IF  ITVPE=1,  SLANT  DISTANCE  IF  ITVPE  GT  1. 
IF  < ITYPE. EQ.1)  RNG=RANGE 

IF  <  ITYPE.Ew,2.AND.<H2,GT.H1  >.  AND  .<  RANGE  .  GT  .  .  5XC0S<  ANGLE*i:  A  >  .)  ) 

1  RHG= . SXCOSC ANGLEkCA > 

IF  < ITYPE.Ew.2.AND.<H2.LT.H1  ;  . AND . 

1  <  RANGfc . GT .  . 5/C0S<  <180. -ANGLE  ^fCA  >  > > 

2  ftNG«= ,  SXCOSf  <180,  -ANGLE  )*CA  > 

IF  ITYPE  .  EQ  .  3  .AND  .  <  RANGE  .  GT  .  ,  5XC0S<  ANGLE^CA  >  )  > 

1  ftNG=.5XC0S<ANGLE*CA> 

IF  < I  TYPE, EO. 3. AND, RANGE. LT. .0001  > 

1  ftNG= , SXCOSC AHGLE*CA > 

ISLANT-ITYPE-l 

CALL  X3CALE  FOR  TOTAL  PATH  LENGTH  TRANSMISSION  FOR  AEROSOL 
CALL  X3CALE<  ALAM, 88 . , EXT55 , TX? ^ lERR , I SLANT, 1HA2E , RNG, ANGLE  > 

IF  < lERR.EQ. 1 >  RETURN 
C  USER  OPTIONS 

IF  (IHAZE.EO.Z)  TX7=EXP<-BETAEX*RANGE> 

IF  <  ISPOT,  AND,  IHA?E.E0i,8)  TX7=EXP< -BE<  KUAVE  IfftANGE  > 

1  CONTINUE 

TX<  9  >=Tx<  9  >•7X7 

IF  < IV. GE. 13000)  TX<3)*TX<8> 

TNEul=TX<9; 

IF  < lEMISS.EQ. 0)  GO' TO  2500 
C  COMPUTER  LIMITS 

BBIK=0 , 0 

IF(aB5< I .43879*V/TBBV< IK)).LT.85. )  BBIK=FF< TBBY< Ik>,V> 

C  AEROSOL  COMPUTATIONS  UNTIL  LABEL  2 

IF  <  IHA2E.EQ,  O.OR.  Ii<.NE.<NCLD-l  >>  GO  TO  2 
C  FIND  AEROSOL  ABSORPTION  IN  DIFFERENT  WAVELENGTH  BANDS  FROM  EXTN 

IF  ■;  ALAM.LT.2.  )  TX  1  0=1  . 

IF  <ALAM,GE.3,  .AND.ALAM.LE.S.  )  TX1 0=TX7** . 2 
IF  <ALAM.GE.8,  .AND.ALAM,LE.r2.05>  TX1  0=TX7*'t' ,  45 

2  CONTINUE 

TLNEW=TX<  9  )i-TX1  0X<  TX<  6  )<*TX7  ) 

TSNEW=TX7*TX<i&  >XTX1  0 
DTAU=AeS<  TLOLD-TLNEW  ) 

IF  <OTAU .LT , 1 , 0E-5.AND.TLNEW.lt . 1 . 0E-5>  GO  TO  2400 
SUMV=SUMV+<  TOLD-TNEW  >iiBBIK 
TL0LD=TLNEU 
TS0LD=T3NEW 
T0LD=TNEW 
2300  CONTINUE 
2400  CONTINUE 
TAUG=0 , 

IF  <HMIM,LE.O,0.AND,IL.EQ.1  )  TAUG=TX<9> 

T1=T< 1 > 

IF  <TBOUND.GT.  0. 0)  T1=TBOLIND 
C  COMPUTER  LIMITS 
660=0 . 0 

IF<ABS< 1  .43879»VXTt  )  . LT . 85 .  )  BBG=FF( T1 , V >*TAUG 
IF  <N16)  RADG<KWAVE)=BBG'»1  .E+04 
IF  <N16)  RADA<KWAVE>»SUMV*1 .E+04 
IF  <HMIN.LE.O)  SUMV*SUMV+BBG 
SUMVV=SUMV 

IF  <IV.GT.IV1)  FACTOR=1.0 
IF  <IV.GE.IV2>  FACTOR-0.5 
SUMV=<  1  .  0E  +  047V*i>2)>*SUMV 


L4M02820 
L4M02830 
L4M02840 
L4M02S50 
L4M02860 
L4M02S70 
L4M02&80 
L4M 02890 
L4M02900 
L4M0291 0 
L4M02920 
L4M 02930 
L4M 02940 
L4M02950 
L4M02960 
1.4M029,'  0 
L4M02980 
L4M02990 
L4M03u00 
L4M0301 0 
L4M0302U 
L4M03030 
L4M03040 
L4M 03050 
L4M03060 
L4M03070 
L4M03080 
L4M03090 
L4M03i 00 
L4M031 1 0 
L4M03120 
L4M0.3130 
L4M03140 
L4M03150 
L4M051 60 
L4M03170 
L4M03 ISO 
L4M03190 
L4M03200 
L4M0321 0 
L4M03220 
L4M03230 
L4M03240 
L4M 03250 
L4M03260 
L4M03270 
L4M03280 
L4M03290 
L4M03300 
L4M0331 0 
L4M03320 
L4M03330 
L4M03340 
L4M03350 
L4M03360 
L4M03370 
L4M03380 
L4M03390 
L4M03400 
L4M0341 0 
L4M 03420 
L4M03430 
L4M03440 
L4M03450 
L4M03460 
L4M03470 
L4M03480 
L4M03490 
L4M03500 
L4M0351 0 
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KHD3L)r1=RHD£UM+DV*pHCT0R'*SUMV 
IF  (.NOT.ISFOT)  WRITE  < lOOUT, 4900 )  V. 

1  ALRM.SUMV, SUMVV, RADSUM,TX<  9), TX7,TX1 0 
IF  <NPLT.EG.1)  WRITE  <NPL0TU>98)  RLPM^SUMW 

98  FORMAT  <F7,4,1X,E13.5> 

IF  <SUMV.GE,RAOt1AX>  VRMAX=V 
IF  (  SuMv  ,  GE  .  RADriAX  ^  R«DWhX=SUMv‘ 

IF  <sumv,le.radmin:>  vrmin^v 
ic  <  SijnV  .  LE  .  RADmIn  ;  RADnIN=SLjMV 
iSOO  Ae=t  . -TX<  9  ) 

IF  < I V . EG . I  Vi . OR . I V . GE . 1V2 i  AB  =  0.5*hB 

SyM«-SUMrt+A8*DV 

Ih  < IEMI33 . EG . 1 >  GO  TO  2600 

IF  <.HOT.ISFOT)  WRITE  <100UT,5000)  IV, 

1  ALAM  .<  TX<K  ),K=1 , 6  ),  TXC  11  ),  TX<:  i2  ),  TX<  f3),  TX<  1  4), 

2  SUMA, TX< 9  ), TX7 

IF  (NPLT.EC.O  WRITE(.NPLOTU,  99  >  ALAM ,  <  TX<  K  K=  1 , 6  ),  <  TXC  J  >  ,  J=  1  1  , 

99  FORMAT  < F7 . 4 , 1 0< 1 K , F6 . 4 > ) 

2600  COHTIHUE 

RESPFN=RESFH^  NR , ALAH ) 

SUMRPF=3UMRPF4RESPFN 

IF  <  IV. GT.  IV1  >  SLlMINT=SLiMINT+,5*<0LDTX9>»0LDRFN+TX<9i*RESPFN  >♦ 

+  A63<  1  .  Xt-LOAT';  I V  >-l  .  XFLOAK  I V-IDV  i  >*1  .  E+04 
IF  (Nib)  TRAN<KWAVE>=TX<9> 

0LDTX9=TX<  9  > 

OLDP.FN=RESPFN 
I V=IV+IDV 

IF  <1V.GE.IV2>  GO  TO  2700 
GO  TO  1300 
2700  CONTINUE 

IF  <NR.NE. t  >  SUMRPF=1  . 

SUMINT=SUMINT,^  SUMftPF*!  ,E  +  04*ABS<  1  ,XFLOAT<  IVl  >-»  .  XFLOAT(  I V2  >  >  .■> 
IF  (.NOT, I  SPOT >  TRANC 1  )=SUMINT 

IF  <  .not . ISPOT . AND .NR .EQ . 1  >  WRITE  <IOOUT,3250>  SUHINT 
IF  < .NOT. ISPOT. AND. NR, NE.1 )  WRITE  <I00UT,3275>  SUMINT 
RESPFN=0 , 

SUMRPF=0 , 

SUMINT=0 , 

IF  (( lEMISS. EG. 1 ). AND, < .NOT, ISPOT))  WRITE  (IOOUT,5100) 

1  VRMIN,RADMIN, VRMAX.RADMAX 

JSTOR=0 

Ae=l  .  0-SUMA,'FLOAT<  IV-IVJ  > 

IF  (ISPOT)  RETURN 

WRITE  <IOOUT,S200)  IVl , IV, SUMA, AB 

IF  << lEMISS.EQ, 1  ). AND. <  .NOT, ISPOT))  WRITE  <100UT,5300)  RADSUM 
IF  (.NOT. ISPOT)  READ  <KiIN,3300>  IXY 
IF  <  IXY.EQ. 0)  GO  TO  31 00 
GO  TO  (2800,700,2900,680,3100), IXY 
2300  CONTINUE 

READ  (IOIN,5400)  V1,V2,MULDV 

CALL  CKER  ( V 1 , V2 , DV , I V 1 , I V2 , I DV , lERR , MULDV, 1  SPOT , TRAN( 1  ) > 

IF  < lERR.EO, t )  RETURN 
AVU=1 0000. XVI 
aLAM=1 0000 ,XV2 

WRITE  (IOOUT,5500)  V 1 , V2 , DV, ALAM, AVW 
SUMA=0 , 0 
GO  TO  1100 

2900  IF  (MODEL. EQ.O)  GO  TO  800 
GO  TO  401 
3000  CONTINUE 

READ  (IOIN,3300)  MODEL, IHA2E, ITYPE,LEN, JP,HPLT, IM, 

1  ML, ieMISS,RO,TBOUND,BeTAEX 

IF  ( lEMISS.EQ. 1 )  WRITE  <100UT,4100) 

IF  < lEMISS.EQ. 0)  WRITE  <IOOUT,4200) 

LEHTOR=LEN 
GO  TO  800 
RETURN 

FORMAT  <X,  }X,48HWAVELEHGTH  AMD  SENSOR  INTEGRATED  TRANSMISSION  > 
+,E10,4> 


31  UU 
C 

3250 


L4M03520 
L4M03530 
L4M03540 
L4M03550 
L4M03560 
L4M03570 
L4M035S  u 
L4H 03590 
L4n03b00 
L4M03bt  0 
L4iiu3b20 
L4M03b30 
L4M03b40 
L4M03650 
L4M03660 
L4M03670 
14 )L4M03680 
L4M03690 
L4M03700 
L4M0.3?  1  0 
L4M03720 
L4M03730 
L4M03740 
L4I'}03750 
L4M0j760 
L4M03770 
L4MU3780 
L4M03790 
L4Mu36uu 
L4M0381 0 
L4M05820 
L4M0383C 
L4M03840 
L4M03850 
L4M03860 
L4M03870 
L4M036S0 
L4M03890 
L4M03900 
L4M039I 0 
L4M03920 
L4M03930 
L4M03940 
L4M03950 
L4M03960 
L4M03970 
L4M03980 
L4M03990 
L4M04000 
L4M0401 0 
L4M04020 
L4M04030 
L4M04040 
L4M04050 
L4M04060 
L4M04070 
L4M04080 
L4M04090 
L4M04t  00 
L4M041 1 0 
L4M04120 
L4M04i30 
L4M04140 
L4M04150 
L4M04160 
L4M04170 
L4M041d0 
L4M04190 
L4H04200 
L4M0421 0 
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!  FukHpT  <  z',  i  X,  37HUhvELEhGTH  InTEukhTED  TRHNSrllSbiuN  »  ,Et0.4> 

)0  FORMftT  <  913, 3F1 0 . 3  > 

)0  FORMAT  <F6. 1 ,2<E9.3,F5, 1 ,E9.3,2E7, 1 >> 

0  FORMAK  3F8 . 3  ) 

>0  FORMATS F6. 1 , 37X, E9 . 3,F5 , 1 ,E9.3,2E7. I > 

)0  FORMAT  < 4< F6 , 3,2F7 .4  )  ) 

30  FORMAT  < 1 5F5 . 2 > 

I  0  FORMAT< 15F5.3) 

30  FORMAT  ':bE9.2) 

3  0  FORMAT  < 12F6 . 3  ) 

I  0  formats  1 0F8 , 4  > 

>0  FORMAT< 1 0FS,3) 

30  FORMAT  <  1  HI  ,  40X ,  36HLT4M  ATMOSPHERIC  TRANSMISSION  MODULE  1  X , 

1  45HPR0GRAM  WILL  BE  EXECUTED  IN  THE  EMISSION  MODE) 

30  FORMAT  <  1  HI  ,  40X  ,  36HLT4M  ATMOSPHERIC  TRANSMISSION  MODULE  1  X  . 

1  49HPR0GRAM  WILL  BE  EXECUTED  IN  THETRANSM I SS I  ON  MODE) 

30  FORMAT  <X10X,jSH  EQUIVALtNT  SEA  LtVfcL  ABSORBtR  AMOUNTS 

1//21X,56HWATER  VAPOUR  C02  ETC.  OZONE  NITROGEN  < CONT ) 

2  42H  H20  <COHT)  MOL  SCAT  OZONEC U-V  )X24X , 

3  7HGM  CM-2, 1 0X,2HKM, 1 0X,6HATM  CM , 1  OX , 2HKM , 9X , 7HGM  CM-2, 

4  1 0X,2HKM, 1 0X,6HATM  CM) 

3  0  FORMAT</'1  OX,  1  OH  W<  1 -6 , 8  )= ,  7<  E 1  4 , 3  ),M  X ,  1  OX .  7H  UK  1  0  )= ,  5SX  ,  E 1  4 , 3,0 

31  FORMAT<  7/'23X,  1  1HNITRIC  AC  I D ,  8X ,  3HS02 . 1  1X,3HNH3,  1  1X,3HNCiS/) 

3  0  FORMAT<  Xl  OX,  1  OH  UK  1  1  -  1  6  )= ,  6<  E 1  4 , 3  ),- ) 

30  FORMAT  <  1  H 1 , 3  OX  ,  28HR  AD  I  ANCE<  UATTS.''CM2-STER-XXX  )  > 

30  FORMAT  <1H  , 1  OX , 37HFR< CM- 1  )  WVL<MICRON)  PER  CM-1 

1  1 OHPER  MICRON, 26H  INTEGRAL  TRANS , 1 X , 4< I H- > , 

2  11H  AERO  TRAN  , 4< 1 H- ) , X , 1 X, 84X , 1 7H  EXTN  ABS) 

30  FORMAT  < 1 H 1 , X , 1 X , 2X , 1 5HFREQ  WAVELENGTH , 2X , 3HH20 , 3X , 4HC02+ , 4X , 

1  30HOZONE  N2  C  H20  C  MOL  S  ,tX, 

2  22HN1TRIC  S02  HN03, 4X , 1 6HN02  INTEGRATED, 

3  2X,,  13HT0TAL  AEROSOLX 1  X ,  1  X,  1  3H  CM-1  MICRONS,  1  0<  3X,  5HTRANS  ) 

4  2X,24HABS0RPTI0H  TRANS  TRANS) 

30  FORMAT  <1H  , 1  OX , F8 . 1 , F 1 3 . 6 , 3E 1 3 . 5 , F 1 3 . 6 , 1 X , F7 . 5 , 3X , F7 , 5 ) 

30  FORMAT  <1H  , 16 , 1 1 F8 . 4 , F 1 1 . 4 , F8 . 4 , 1 X , F7 . 5 ) 

30  FORMAT  <1H0,8H  RADMIN  , FI  2 . 3, El  2 . 5 , X, 8H  RADMAX  ,F12,3, 

1  E12.5) 

30  FORMAT  <1H0,26H  INTEGRATED  ASORPTION  FROM, 15, 4H  TO  ,15, 

1  7H  CM-1  =,F10.2,25H,  AVERAGE  TRANSMITTANCE  =,F6.4) 

30  FORMAT  <1H  , 22H  INTEGRATED  RADIANCE  =,E12.5,13H  WATT  CM  -2  ,2HSR 
30  FORMAT  <2F1 0.3, 12) 

30  FORMAT  <X10X,2iH  FREQUENCY  RANGE  V1=  ,F7.1,9H  CM-1  TO  , 

1  4HV2=  ,F7.I,14H  CM-t  FOR  DV  =,F6,i..9H  CM-1  ( 

2  ,F6.2,3H  -  ,F5.2,10H  MICRONS  >) 

END 


L4M04220 
L4M04230 
L4M04240 
L4M04250 
L4MU4260 
L4M04270 
L4M04280 
L4M04290 
L4M04300 
L4M0431 0 
L4M04320 
L4M04330 
L4M0434u 
L4M04350 
L4MC‘4360 
L4M04370 
L4M04j60 
,  L4M04390 
L4M04400 
L4M0441 0 
L4M04420 
L4M04430 
L4M04440 
L4M04450 
L4M04460 
L4M04470 
L4M04480 
L4M04490 
L4M04500 
L4M0451 0 
L4M04520 
, L4M04530 
L4M04540 
L4M04550 
L4M04560 
L4M04570 
L4M04580 
L4M04590 
L4M04600 
)L4M0461 0 
L4M04620 
L4M04630 
L4M04640 
L4M04650 
L4M04660 


r 


r 


SUBROUTINE  »BSORB< IXY, IERR,«, VI , V2 . DV , SUMA , HULDV, hNGLE, LEN, ITY 
I  HI .H2,M0DEL . 1SPOT1 , RANGE, BETA, VIS. ICLNAT, IV1 , IV2, IDV> 

COMt^ON  /GEOMET/PTS':  15).  IGEOSU 

COMMON  /CLYMAT/TEMP. PRESS. RH1 . AH1 .DPI .VIS1 .CLDAMT, 

1  CLOHYT.FOGPRB.WNDVEL.UHC'DIR.  IPASCT 

COMMON  /CONST.^PI  .PI2,  CA.  TUOPl .  TORRMB .  CDEGK 

COMMON  /lOUNlT.MOIN. lOOUT . IPHFUN , LOUNI T , NDIRTU . NCL IMT . KSTOR . NP 

COMMON  /MO  )  /EH<  1  6 . 34  ) .  P<  34  ) .  T<  3«»  ) .  WH<  34  ) .  Z<  34  ) .  WAC  34  ) .  RE .  M .  NL 

COMMON  /M02/  WO>:  34  ) .  RO .  TBQUND ,  JP .  I M .  ML ,  IP .  JSTOR 

COMMON  /M09/RADMAX , RAOMIN. VRMAX. VRMIN 

COMMON  /EM1/HMIN,KMAX, I J. J1 . J2, JMIN. JEXTRA.NP1 

COMMON  /LOti.iEX/WPATH<SA.  1 6  ) .  WL AY<  34 . 1 6  > .  TBBYC  68  >.  TX<  16  >.BETAEX. 

1  CLOHGT.NCLO 

COMMON  /SPOTLO/ISPOT.LOREAD.H16 

COMMON  /M03/  FS<  9  ) . S K  9  )  . S2<  S  ) . FNH3<  9  ), FH1 <  9 ). FH2<  9  >, FN02<  9  ), 

1  or,  9).02<  9).PPMS02.PPMNH3.PP«N02 
LOGICAL  ISP0T.N16,L0REA0 
DIMENCION  VH< 16  ).W< 16 >.E< 16 ) 

C  EH<7.I)  REPLACES  HSTOR 

C  EHO.I)  REPLACES  HMIX 

DATA  <EH<9. I  ). 1  =  1 .34)  /9  +  0 . . 0 . 1 . 0 . 33 , 0 . 8 . 1  . 2 . 1  . 4. 1  . 6 . 1  , 8 . 1  , 9 . 

1  2,0.2. 1.2. 3. 3. 0.3. 7. 4, 2. 5. 2. 6. 0.3. 8. 2. 6. 0.22. 6* 0.0/ 

F<  A  ')=EXP<  1  8 . 9766-14 . 9595>*  A-2 . 43882'^A*A  >*A 
TMPVIS=VIS 

IF  <  ISPuTI  ,  Eu . 1  )  GO  TO  200 
IF  < MODEL . EO . 0 >  GO  TO  400 
IF  <lXY.tu.3)  GO  TO  100 
IF  <M,EQ.7.AND.IM,NE.O)  GO  TO  400 
IF  <IXY.GT,3>  GO  TO  1500 
C  WHEN  IXY=0  VIS  IS  READ  IN  MAIN 

too  IF  C  .NOT. ISPOT)  READ  <IOIN.6200>  HI .H2, ANGLE, RANGE. 

I  BETA. VIS, CLDHGT 
IF< IGEOSU.NE . 1  )  GO  TO  111 
H1=PTS<3) 

H2=PTS<6  > 

RANGE=SQRT<  <  PTS<  1  )-PT3<  4  >  )**2+<  PTSC  2  )-PT.5<  -5  >  >**2  + 

+  (  PTS<  3  )-PT3<  6  >  )‘»‘«2  > 

111  CONTINUE 

IF  (IXY.EQ.O)  VIS=--TMPVIS 
200  X1=RE+H1 
X2=RE+H2 

IF  <  ITYPE.EG(.3)  GO  TO  1000 


IF 

IF 


( ITYPE.EO. 1  )  GO  TO  1500 
< RANGE. EG. 0,  )  GO  TO  1200 


IF  <.NOT.ISPOT)  WRITE  <IOOUT.6300>  HI . H2. ANGLE , RANGE . 

1  BETA. VIS 

IF  f.  H2.EQ,  0.  AND,  ANGLE.  NE.  0)  GO  TO  300 

ANGLE=  ACOSt  0 . 5*<  <  H2-H i  >*< 1  . +X2/X 1  )/RANGE-RANGE/X I > )/CA 
GO  TO  1400 

3  0  0  X2=SQRT<  C  XI /RANGE+RANGE/X 1 +2 . 0*COS<  ANGLE*CA  >  >*X 1 ♦ 

1  RANGE  > 

H2=X2-RE 
GO  TO  1400 
400  CONTINUE 

IF  tML.LE. 0)  ML=1 
DO  900  K=1 .ML 

CLIMATE  OPTION  -  SEE  COMMON  /CLYMAT/ 

IF  <M. EQ, 0. AND, .NOT. ISPOT)  READ  <I01N.6400>  H1,P<1). 

1  TMP,  DP,. <H.UH<K),UIO<K),  VIS.  RANGE 

IF< IGEOSW.NE . 1  )  GO  TO  444 
H1=PTS<3> 

H2=PTS<6) 

RANGE=SQRT<  <  PTS<  1  I-PTSC  4  >  )*>t.2+<  PTS<  2  )-PTS<  5  >  )**2+ 

+<  PTS<  .3  >-PTS<  6  >  >**2  > 

444  CONTINUE 

IF  <  ICLMAT.HE. 1 )  GO  TO  500 

TMP=TEMP 

P-;  1  >=PRESS 

DP=DP1 

RH=RH1 


PE,  ABSOOOlO 
ABS00020 
ABS00030 
ABS00040 
AB300050 
ABS00060 
LOTUABSC0070 
ABS00080 
ABS00090 
ABS001 00 
ABS001 1 0 
A8S00120 
ABS00130 
AeSOOMO 
ABSOOISO 
Aesool 60 
ABS00170 
ABS00180 
ABS00190 
ABS00200 
AeS0021 0 
ABS00220 
ABS00230 
ABS 00240 
ABS00250 
AB600260 
ABS00270 
ABS 00280 
ABS 00290 
ABS 003 00 
ABS 0031 0 
ABS00320 
ABS00330 
ABS 00340 
ABS 00350 
ABS00360 
ABS00370 
A8S00380 
A6S00390 
ABS 004 00 
ABS 004 1 0 
ABS 00420 
ABS00430 
ABS00440 
ABS00450 
ABS00460 
ABS00470 
ABS004S0 
ABS00490 
ABS 005 00 
A6S0051 0 
ABS00520 
AB600530 
ABS00540 
ABS00S50 
ABS 00560 
ABS00570 
ABSOOSSO 
ABS00390 

Assooeoo 

ABS0061 0 
ABS00620 
ABS00630 
ABS 00640 
ABS00650 
ABS00660 
ABS00670 
ABS00680 
ABS00690 
ABS 007 00 
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WM^  K  ;  =  HH 1 

VIS=VIS1 

IF  (  IXY  .  EQ  .  u  .  hND  .  ICLMhT  .  hE  .  1  >  VIS=TrlKVI3 

IF  <  <  M  ,  GT  ,  U  >  ,  ANC>  .  <  .  NOT  .  ISPuT  >  >  REhD  <  JOIN.  34  00  >  2<k;>, 

I  P<K),TMP,DP,RH,yH<K),lJO<K  > 

IF  <<M  ,EQ  .  0)  ,  AND  .  <  .HOT  .  ISPOT  >  )  WRITE  <IOOIJT,  6500  >  HI, 

I  P<  1  TUP, DP, RH,UH<K),UO<K>, VIS, RANGE 

IF  <  M , EQ , 0  )  Z<  K  )  =  HI 
J=IFI><<2<K)+1  .0E-b>+1  . 

IF  <2CK).GE,25,  )  J=< 2< K  )-25 .  >/5 . 0+26 . 

IF  (2(k>.uE,50.U>  J=<  2<.' K  )-50  .  >k2  0  , +31  . 

IF  <2(;K>,GE,70,  )  J=<Z<k>-70.  )230.+32. 

IF  <  J  .  GT  ,  .53  j  J*=33 
FAC  =Z<  K  >-FLOATC  ..I-  1  ) 

IF  ' J.LT.2b>  GO  TO  600 

t- AC  =  <  2<  k  >-5 . 0  +  FLOAT<  0-26  >-25  .  >75  . 

IF  <J,GE,31>  I- AC  =  <  2<  K  >-5  0  .  >22  0  . 

IF  <J.GE.32>  FAC=<2<K>-70. >230. 

IF  <  (-AC  .  GT  .  1  .  0  >  f-HC.=  1.0 
L=0+1 

T; k  >=TMP+CDEGK 
TT=CDEGK2T<  k  > 

IF  <RH.Lt.0.0>  TT=CDEGk2< CDEGk+DP > 

IF  <  UIH(  k  j  .  Lt ,  0  .  0  >  WH<K>=F<TT> 

1 1-  <kH.Gi.0.0>  WH<  k  >»0 . 01  ♦RH't'UH';  k  > 

EH<7,k  >=0. 0 

IF  <EH<9, J),LE. 0, )  GO  TO  700 

EH<  7  ,  K  >=EH<;  9 ,  0  >*<  EH<  9 ,  L  >2EH<:  9 , 0  >  )**FAC 

CONTINUE 

IF  <  MODEL,  ECi.O  GO  TO  1500 

IF  <<;k.EG.  1  >.ANO,<  .NOT.ISPOT>>  WRITE  <IOOUT,6600> 

IF  <.NOT,ISPOT>  WRITE  <IOOUT,6400)  2< K > , P< K > , TMP , DP , 

I  RH,UH<k),UO<k) 

CONTINUE 

Iri=U 

NL=ML 

NOTE  THAT  2< 1 >  MAY  NOT  CORRESPOND  TO  THE  VALUES  GIVEN  FOR 
MODEL  ATMOSPHERES 
IF  <  IkY,GE.3>  GO  TO  1500 
GO  TO  100 

IF  < RANGE. GT. 0. 0>  GO  TO  1100 

GO  TO  1500 

ITYPE=2 

BETA=  ACOS<  0 , 5+<  RANGE*RANGE2<  X 1  *X2  .>-X22X1  -X 1  2X2  >  >2CA 

IF  <BETA.EO.0,>  GO  TO  1300 

BET=CA*BETA 

X2=RE+H2 

ANGLE=ATAN<:  X2*SIN<  BET  )2<  X2*C0S<  BET  >-X1  >  >2CA 
IF  < ANGLE, LT. 0. >  AHGLE=ANGLE+P I 
RANGE=X2*SIN<  BET  >2SIN<  ANGLE+CA  > 

BET=6ETA 
GO  TO  1500 

RANGE>«<  X22X1  >'*>*2-<  SIN<  ANGLE*CA  >  >"»>»2 

IF  < RANGE, GE. 0, 0>  RANGE=X 1 *< SGRT< RANGE >-AB3< COS< ANGLE*CA > > 
IF  <ANGLE.NE.  0,  .OR. ANGLE. NE.  180.  >  BET=ASIN(;RANGE  +  SIN<  ANGLE 
IF  < ANGLE, LT. 0. >  ANGLE*ANGLE+P I 
IF  <  RANGE.  LT.O.O  RANGE— RANGE 
BET=BET2CA 

IF  <.NCT,ISPOT>  WRITE  <IOOUT,6300>  HI , H2 , ANGLE , RANGE , 

I  BET, VIS 
CONTINUE 
DO  1600  1=1, NL 
DO  1600  J=1,KMAX 
WLAYC I, J>=0, 

SUMA=0, 

WHEN  IXV-0  V1,V2,MULOV  ARE  READ  IN  EOSAEL.MAIN 
IF  <  < IXY.EQ. 1  .OR , IXY ,EQ .2). ANO.<  .NOT . ISPOT  >  > 

I  READ  <IOIN,6250>  V1,V2,MULDV 

IF  << IXY .EQ. 1 .OR . IXY.EQ .2 ) ,AMD.< .HOT. ISPOT >> 
f  CALL  CKER  < VI , V2 , DV, IV I , I V2, lOV, lERR. MULDV, ISF jT, TMPVIS > 


ABSuu.'i  U 
ABS 00720 
mBS00.'30 
ABS  0  074  0 
APS00750 
ABS00760 
ABS00770 
ABS00780 
ABS 00790 
ABS 008 00 
ABS00S1 0 
ABS00820 
ABS 0 0830 
ABS 00840 
ABSOOasO 
ABS00S60 
ABS0u87O 
ABS 00880 
ABS0U890 
ABS 009 00 
ABS 0091 0 
ABS00920 
ABS 00930 
ABS  0  094  0 
ABS00950 
ABS00960 
ABS00970 
ABS00980 
ABS00990 
ABS 01 000 
ABS01 0 1 0 
A8S01 020 
ABS01 030 
ABS01 040 
ABS 01 050 
ABS 01 060 
STANDARDABS01 070 
ABS 01 08 0 
ABS 01 090 
ABS01 I  00 
ABS 01 1 1 0 
ABS01 120 
ABSul 130 
ABS01 140 
ABS 01 150 
ABSOI 160 
ABS01 170 
ABSOI 180 
ABSOI 190 
ABSOI 200 
ABSOI 21 0 
ABSOI 220 
AB301230 
>  AB301240 

*CA  >2X2  >ABS01 250 
ABS 01 260 
ABSOI 270 
ABS01280 
ABSOI 290 
ABS01300 
ABSOI 31 0 
ABSOI 320 
ABS01330 
ABS01340 
ABS01350 
ABS01360 
ABS01370 
ABSOI 380 
ABS01390 
ABS0t400 
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IF  <ieRR,EQ.l>  RETURN  ,  .  , 

IF  <  <  ITYPE  .EQ  .  1  )  .  AND  .  <  .NOT  .  ISPOT  WRITE  <IOOIJT.6700> 

1  HI, RANGE 

IF  <<  ITYPE.EG.2>.AND,<  .NOT.  1SPCIT>>  WRITE  <IO0IJT,68O0> 

1  HI, H2, ANGLE 

IF  < <  ITYPE  .EQ  .  3  )  .  AND . <  .NOT . ISPOT > >  WRITE  < lOOUT, 6800 ) 

1  HI, ANGLE 

IF  < MODEL. EQ. 0)  M=7 

IF  << M . EQ . 1 >. AND .<• NOT . ISPOT > >  WRITE  <IOOUT,720u>  M 
IF  <<M.EQ.2).AND.<  .NOT.  ISPOT))  WRITE  <IOOtJT,7300>  M 
IF  <<M.E0.3).AND,<  .NOT.ISPOT))  WRITE  tIOOUT,7400)  M 
IF  <<M. EQ. 4). AND. <  .NOT.ISPOT))  WRITE  <IOOIJT,7500)  M 
IF  <<M.EQ.5).AND.<  .NOT. ISPOT))  WRITE  <IOOUT,7600)  M 
IF  <<M. EQ. 6). AND. < .NOT.ISPOT))  WRITE  <IOOUT,7700)  M 
IF  <<M. EQ. 8). AND. <  .NOT.ISPOT))  WRITE  <IOOUT,780Ci)  M 
IF  ‘:<M.EQ. 8). AND.*:  .NOT.ISPOT))  WRITE  <  lOOUT,  79  00  )  M 
AVW=I  000  0./'V1 
ALAM=1 0000. /V2 
RADMiN=l . 0E+3b 
RADriAX=Cl . 

YRMIN=0 . 

VRMAX=0 . 

IF  <. NOT. ISPOT)  WRITE  ■:  lOOUT,  SOOO)  VI ,  V2,  DV,  ALAM,  AVU 
AVW=«0 . 5E-4*<  VI  +V2  ) 

AvW=AVW’»AVW 

IF  << JP.EQ. 0). AND. < .NOT. ISPOT))  WRITE  <IOOUT,8100> 

IF  <  ITYPE, EQ.1)  GO  TO  2100 
DO  1800  K=1 ,KMAX 
VH<K)=0. 0 
1800  CONTINUE 
BETA=0. 0 
SR=0. 0 
IP-0 

NOW  DEFINE  CONSTANT  PRESSURE  PATH  QUANTITES  EH<1-8> 
Y=CAfANGLE 
SPHI-SINCY) 

R1=<RE+H1 >*SPHI 

IF  <H1 .GT.Z<NL))  CO  TO  1900 

GO  TO  21 00 

1900  X=<RE+Z<NL  ))ARE+H1  ) 

IF  <SPHI .GT.X)  GO  TO  2000 
H1=Z<NL  ) 

J1=NL 

SPHI=SPH1/’X 

ANGLE=180.0-  ASIH< SPHI )/CA 
R1=< R£+Ht )fSPHI 
GO  TO  2100 
2000  HMIN=R1-RE 

IF  t. NOT. ISPOT)  WRITE  <IOOUT,8200)  HHIN 
GO  TO  6000 
2t  CO  DO  2400  1  =  1, NL 
P3=P< I  )X1 013. 0 
TS=COEGK,''T<  I  ) 

X=PS*TS 

C -  COMPUTE  MASS  DENSITY  <G  M-3)  FROM  IDEAL  GAS  LAW  - 

C -  1292.02  =  DENSITY  OF  STANDARD  COMPOSITION  AIR  AT  STP  - 

WA< I >  =  1292. 02fX 
PT=PSt.SQRT<TS> 

0=0. 1*UH< I ) 

EH< 1 , I >«D*PT**0,9 
EH<2,I)-X>*PT*f0.75 
EH<  4,  I  >-0.8<*PT*X 
PPW-4 . 56E-3t'D>»COEGK/TS 
TS1-<296.0XCDEGK >*TS 

EH<5,  I  )»D*PPW>*EXP<6,  O0*<TS1-1  .  0  >  >+0 . 002*D*<  P3-PPW  > 

EH< 1 0, I )»D*<PPW+0.  I2*<PS-PPW))*EXP<  4.56*<  TSl-1 , 0>> 
EH<6,I)=X 

EH<8, I  )=46.6667*W0< I > 

EH<3,  I  )-EH<8,  I  >>»PT*>»0,4 
C  EH<  1  1  ,  1  )=HN03  ABSORBER  AMOUNT  <  ATM-CM  )/'KM 


A8S01 41 0 
ABS01420 
ABS01430 
ABS01440 
A6S01 450 
ABS01460 
ABS01470 
ABSOI 480 
ABS01 490 
ABS01500 
ABS0151 0 
APS01520 
ABS0t530 
ABS01540 
ABS01550 
ABS01560 
ABS01570 
ABS01580 
ABSOI 590 
ABSO i 600 
ABSOibi 0 
ABSO 1620 
ABS01630 
A6S01640 
ABSOI 650 
ABS01660 
ABS01670 
ABS01680 
ABS01690 
ABS01700 
ABSOI 7 1 0 
AeS01720 
ABSOI 730 
ABS01740 
ABSOI 750 
ABS01760 
ABS01770 
ABS0178G 
ABSOI 790 
ABSOtSOO 
ABSOI 81 0 
ABSO 1820 
ABSO 1830 
ABSO 1840 
ABSOtSSO 
ABS01860 
ABSOI 370 
A6S01880 
ABS01d90 
ABS01900 
ABS0191 0 
ABS01920 
ABSOI 930 
ABS01940 
ABS0t950 
ABS01960 
ABS01970 
ABS01980 
ABSOI 990 
ABS02000 
ABS0201 0 
ABS02020 
ABS02030 
ABS02040 
AB302050 
ABS02060 
A6S02070 
ABS02080 
ABS02090 
ABS021 00 
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EH< 1 1 , I  )=PS*TSfEH<  9, I 1  . OE-04 

IF  <MODEL.EQ, 0. OR. MODEL. EQ.7>  EH< 1 1 . 1 >*PS*TS*EH< 7 , I  )* 1  . OE-04 
C*****EH(  12, 1  )  =  S02  ABSORBER  AMOUNT  <  ATM-CM  >.'’KM 

EH<  12,  :  >=0,772E-04*PPMS02>»WA<  I  )*PS'»>»0. 07 1  22*TS**  0 , 06159 
EH< 13, I  )  =  0 .772E-04*PPMNH3fWA< I >*PS*f 0 . 52 1 25*TS**< - 0 . 6 0438 > 
EH<  14,  I  )  =  0,772E-04*PPMN02**I«IA<  1  >*PS**0.  1  8 066>*TSH<f  0 . 2 09 1  1 
C^.*.*K=15  for  ASL  3.3  -  4.3  MICRON  H20  CONTINUUM 
EHC.  15,1  >=PPW*0 

C  ++>4<K«16  for  4.6  -  4.8  MICRON  H20  CONTINUUM 
EHC  16,  I  >=PPWi.<PPU)+3. 0E-03*<PS-PPU)> 

IF  <  I  .EQ.NLI  GO  TO  2300 

IF  <MODEL .EQ . 0 . AND . I .GE. I )  GO  TO  3600 

T2=T< 1+1 > 

W2=UIH<  1  +  1  > 

PPU)=‘i- .  56E-6>fU2’t‘T2 
2300  IF  <Hl.GE.2<I)i  J1=I 

IF  < < JP . Eu . 0 > . AND . < . NOT . ISPOT > > 

1  WRITE  <  IOOUT,8300.>I,2<  I  .1 ,  <  EH<  K ,  I  ; ,  K 
2400  CONTINUE 
X1=H1 

CALL  POINT  <H1 ,N,NP1 ,TX> 

J1  =N 

DO  2500  k=l,kMAX 
25  0  0  E<k)=TX<K) 

JEXTRA=0 
JMIN=0 

C+*ITYPE=1  MEANS  HORIZONTAL  PATH 
IF  <ITYPE.E«.1)  GO  TO  3600 
IF  <ITYPE.E0.3)  H2=2tHL> 

C++  ANGLE  GREATER  THAN  90  DEGREES  MEANS  DOWNWARD 
IF  < ANGLE . GT . 90 . 0 )  GO  TO  5800 

“  ‘  NOT  HORIZONTAL  OR  DOWNWARD  THEN 

90. 0.AND.NP1 .GT. 0>  J1»d1+1 


1,6>,EH(8,  I  :>,<EH<K,  I  :),K=1  0,  1 


+ +  +  +  +  +  +  ++  +  «  +  «  +  » +  +  +  +  +  +  +  + 


TRA..IECTORY  +++++•+**  + 


C**  IF 
260  0 


IS 

.GT. 


2700 


2800 


2900 


,  EQ.3>  GO  TO  2700 
<H2,N,NP,TX> 


■1 


THE  PATH 
IF  < ANGLE 
J2=NL 
IF  < ITYPE 
CALL  POINT 
J2*N 

IF  <NP.GT.O)  J2=J2 
DO  2800  k=1  ,  k'MAX 
IF  <K.EQ.9.0R.K.EQ.7)  GO  TO  2800 
EH<k,  J1  >=»E<k  ) 

IF  <1TYPE.EQ.3)  GO  TO  2800 
EH<k,  J2+1  >=TX<K) 

CONTINUE 

NOW  DEFINE  VERTICAL  PATH  QUANTITIES  VH< 1 -8 > 

IF  << JP.EQ. 0>.AND.< .HOT. ISPOT>>  WRITE  <100UT,8400> 

DO  2900  K=1 ,KMAX 

W<K)=0- 

DO  3500  I=J1 , J2 
X1-2<  I  ) 

X2=Z<l  +  0 
X2»Z< I ) 

X1-H1 
X2=H2 


IT  IS  UPWARD  TRAJEC 


IF 

IF 

IF 

IF 


«;  I  .  LT  .  NL  > 

<  1  .EQ.NL> 

< I .EQ. J1 > 

<I.EQ.J2> 

DZ=X2-X1 

IF  <I.EQ.NL>  D2-Z< I >-Z< I-l > 
DS=D2 

C+++++  UPWARD 


TRAJECTORY 
RX=<RE+X1  )ARE+X2> 

THETA=  ASIN<SPHI >/CA 
PHI=  ASIN<SPHI+RX)/’CA 
BET=THETA-PHI 
SALP^RX+SPHl 

IF  <SPHI .GT. 1 ,E-1 0)  DS-<RE+X2>+SIN<BET+CA>/SPHI 

BETA=BETA+BET 

PSI+BETA+PHI -ANGLE 

PH1=180.-PHI 

SR=SR+DS 

JEXTRA-0 

DO  3400  K=1 ,KMAX 


ABS021 1 0 
ABS02120 
ABS02130 
ABS02140 
ABS02150 
ABS02160 
ABS02170 
A6SD2180 
ABS02190 
A6S02200 
ABS0221 0 
ABS02220 
A6S02230 
ABS02240 
ABS02250 
ABS02260 
A&S02270 
4>ABS02280 
ABS02290 
ABS02300 
ABS0231 0 
A6S02320 
ABS023.50 
ABS02340 
ABS02350 
ABS02360 
++ABS02570 
ABS 02330 
ABS02390 
++ABS02400 
ABS024t  0 
TOABS02420 
ABS0243O 
ABS02440 
ABS02450 
AB&02460 
ABS02470 
ABS02480 
ABS02490 
ABS 025 00 
ABS0251 0 
ABS02520 
ABS02530 
ABS02540 
ABS025s0 
ABS 02560 
ABS02570 
ABS02580 
ABS 02590 
ABS02600 
ABS0261 0 
ABS 02620 
ABS02630 
ABS02640 
ABS02650 
ABS02660 
ABS02670 
ABS 02680 
ABS02690 
ABS02700 
ABS027 1 0 
ABS02720 
ABS02730 
ABS02740 
ABS02750 
ABS02760 
ABS02770 
ABS02780 
ABS02790 
ABS02800 
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3  0  0  0 

3100 
320  0 

33  0  0 

34  0  0 

3500 

3600 

3?  0  0 
.3800 

(]].  »t(  4: 


3900 
4  00  0 

4100 
42  0  0 


IP  <k.  EGi.7.uR.K.Ebi!.9)  GO  TO  3100 
EV*DS*EHCK, I > 

IF  < I .EQ.NL)  GO  TO  3000 

IF  <EH<:K.  1  >.EQ,  0,  O.OR.EH<K.  1  +  1  >.EGi.  0. 0>  GO  TO  3100 
IF  (EH<K,  I  >.EQ.EH<K,  1  +  1  ■>>  GO  TO  3200 
ev=OS+<eH<K, I >-EH<K, I+l >>^ALOG<EH<K, I 1+1 > > 
GO  TO  3200 

IF  <EH<K, I >,EQ. 0 , 0>  GO  TO  3100 
IF  < EH<K, 1-1 >.EQ, 0. 0>  GO  TO  3100 
IF  <EH<K.  1  >.EGI.EH<K.  1-1  ))  GO  TO  3200 
EV=EV/ALOG<EH<K, I-l 
GO  TO  3200 
EV=o  . 

VH<K  >=VH<k)+EV 
IF  <I.EQ.JSTOR>  GO  TO  3300 
WlhVc  I ,  K  )=Ev>+W<  K  :> 

U<  K  ;  =  0 , 

GO  TO  3400 
iii';  K  >=EV 

IF  <  01  ,NE, J2>  GO  TO  3400 
WLhy<  j2+  j , K >=U<  K  > 


U<  K  ;)  =  0  . 

jEXTRh=1 

CONTINUE 

IF  < < JP .EQ . 0 >.hND ,<  .NOT . ISPOT  )  >  WRITE  <IOOUT,850O>  I, 

I  XI ,<VH<L>.L=1 ,6)>VH<8),PSI>PHI.BETA.THETA,SR 
IF  < I  .GE.NL)  GO  TO  3300 
SPHI=SPHI*RX 

IF  <ShLP.GE,1.)  SPHI=SALP 

CONTINUE 

GO  TO  5800 

HORIZONTAL  PATH 

DO  3700  k=t,KMAX 

IF  <K.EQ.7.0R.K,EQ.9)  GO  TO  3700 

U<K)=RANGE*EH<K, 1 ) 

IF  <  MODEL.  GT.O)  W<  K  .^«RANGE>*‘TX<  K  > 

VH<t<)=U<K) 

CONTINUE 
GO  TO  6100 
CONTINUE 

DOWNWARD  TRAJECTORY 
K2=0 

IF  (HPI .EQ, f )  Jt=J1-1 
IF  <  J1  ,LE. 0)  J1  =  1 
J2=J1+1 
J*J1+1 

IF  <H2.GT.Z«:  J1+1  >.OR,H1  .EQ.H2';  GO  TO  4000 
IF  <NP1 .EO. 1 .AND.H2,GE,Z< Jl+1 >)  GO  TO  4000 
CALL  POINT  <H2,N,NP2,TX) 

DO  3900  K»1  ,KI1AX 
W<K)sTX<K) 

IF  <H2.LT.H1 )  H«H2 
J2=*N 

A0-<RE+H1 )#SPH1 
DO  4100  1=1 , J1 
HMIN=A0-RE 
JMIN=1 

IF  <HMIN.LE.Z< 1+1 )>  GO  TO  4200 

CONTINUE 

X=HMIN 

IF  <HM1N.LE,0)  GO  TO  4400 
CALL  POINT  <X,N,NP,TX> 

JMIN=N 

HM1N=A0-RE 

IF  <ABS<X-HMIN>.GT. 0. 0001 )  CO  TO  4200 
IF  <H2.GE.H1 >  J2-N 
IF  <N2. GE. HI .OR.H2.lt. HMIN>  H=HMIN 
IF  <.N0T.ISP0T>  WRITE  <IOOUT,8600>  HMIH 
IF  <H2.LT.HM1N>  J2-N 

IF  <<H2, LT. HMIH). AND. < .HOT. ISPOT))  WRITE  <IOOUT,8700> 


HMIH 


ABS0281 0 
AB&02820 
ABS02930 
ABS02840 
ABS02850 
ABS02860 
ABS02870 
ABS 02880 
ABS02890 
ABS02900 
ABS0291 0 
ABS02920 
ABS02950 
A6S02940 
A6S02950 
ABS 02960 
ABS02970 
ABS02980 
ABS02990 
ABS03000 
ABS03ui 0 
ABS03020 
ABSu3u3u 
ABSO0O4O 
AB9D3050 
ABS03060 
ABS03070 
ABS03080 
ABS03090 
A6S03t  00 
ABS 031 1 0 
AeS03120 
ABS031 30 
ABS03140 
ABS03150 
ABS03160 
ABS03170 
ABS03180 
ABS03190 
ABS03200 
ABS 0321 0 
ABS 03220 
ABSD3230 
ABS03240 
ABSO3250 
ABS03260 
ABS03270 
ABSCI3280 
ABS03290 
ABS03300 
ABS0331 0 
A6S03320 
ABSC3330 
ABS03340 
ABS0335G 
ABS03360 
AeS03370 
ABS03380 
ABS03390 
ABS 034 00 
ABS0341 0 
ABS03420 
ABS03430 
ABS03440 
ABS03450 
ABS03460 
AeS03470 
ABS034d0 
ABS03490 
ABS  03*=^  0  0 


332 


GO  TO  4500 

4400  IF  <.NOT.ISPOT)  WRITE  < IOOUT> 8600 >  HMIN 
IF  <H2.LT.H1 >  GO  TO  4500 

IF  << ITYPE.Ee.3.0R.H2.GE,H1  > . AND . < .NOT. I  SPOT >> 

1  WRITE  <  I00LIT,880CO 

ITYPE=2 
JMIH=0 
J2*1 
H2*0 . 0 
H=0, 0 

NOW  DEFINE  VERTICAL  PATH  QUANTITIEo  VH<  1 -a  > 

4500  IF  << JP.Ew. 0).AND,< .NOT. ISPOT>>  WRITE  <IOOUT,840CO 
JSTOR=J-1 
DO  5100  1*1, NL 
J=  J-1 

1  >  X1*2<  J+1  > 


IF  < I .HE . 
X2=Z<  J> 

IF  <  J.EQ, 
IF  <  J . EQ , 


J2 . AND . K2 . EQ . 0  >  X2=H 
JMIN . AND . k2 . EQ . 1 >  X2=HMIN 
HM=<RE+X1 >*SPHI-RE 
IF  (iHM.GT.ZC  Jj.AND.HM.GT.X2>  X2=HH 
RX*<RE+X1  )/'<RE+X2> 

DS=X1 -X2 
ALP=90 , 0 

THET=  AS1N<SPHI  i/CA 
S^LP^RX’t'SPH  I 

IF  <ABS<2-HH>.GT.1  .OE-5)  ALP=  ASIN<  3ALP  )/^CA 
BET=ALP~THET 

IF  <  3PHI  .  GT  .  1  .  OE-1  0  >  DS*<  RE+X2  >*S1N<  BET>*CA  ^/SPHI 
THETA=180. 0-THET 
eETA=BETA+eET 
PSI=BETA-ALP-ANGLE+180.0 
Sft=SR+DS 

DO  5000  K=1,KMAX 
IF  <K.EQ.7.0R.K.E0.9)  GO  TO  5000 
AJ*EH<K, J) 
eJ=EH<K, J+1 ) 

IF  <  J.EQ. J1  )  BJ=E<K) 

IF  < J.EQ. J2, AND.H2.lt. HI .AND. H2.GT.0.0>  AJ=UKK> 

IF  < J.EQ. JMIN. AND. H2.CE. HI >  AJ=TX<K> 

IF  < J.EQ. JMIN. AND. ABS<H2-HM>.LT. 1 . 0E-5>  AJ*TX<K) 

IF  <K2.EQ. 0)  GO  TO  4600 
IF  <  J.EQ. J2)  BJ=W<k) 

IF  <  J.EQ.  JMIN)  AJ«TX<(<) 

IF  <AJ.EQ. 0. O.OR .BJ.EQ. 0 
IF  <AJ,EQ.BJ)  GO  TO  4700 
EV=DS+<  AJ-B J  >2AL0G< A J7B J ) 

GO  TO  4900 
4700  EV*DS+AJ 

GO  TO  4900 
EV=0. 0 

VH<K)=VH<t<)+EV 
WLAY<  J,K)=EV 

IF  << JP.EQ. 0).AND.< .NOT.ISPOT))  WRITE  <IOOUT,8500) 
1  XI ,<VH<L),L=1 ,6),VH<8),PSI,ALP,BETA,THETA,SR 
IF  < J.EQ. J2.AND.H2.GE.H1 )  GO  TO  5600 
IF  < J.EQ. JMIN. AND. K2.EQ.1)  GO  TO  5400 
SPHI-SALP 

IF  < J.EQ. J2. AND. K2.EQ. 0)  GO  TO  5200 
CONTINUE 

IF  <HM1N.LE.0)  GO  TO  5800 
IF  <<LEN.EQ.O>.AND.< .NOT.ISPOT)) 


4600 


4800 

4900 

5000 


51  00 
5200 


0)  GO  TO  4800 


J  t 


WRITE 

WRITE 


IF  <<LEN.EQ. 1 ). AND. < .NOT.ISPOT)) 

IF  <LEH.EQ.O)  GO  TO  5800 
K2«l 
X1»X2 

IF  <ABS<X1-HMIN).LE, 0. 001 >  GO  TO  5800 

H*HMIN 

J« J2+1 

IF  <NP2,EQ. 1 >  J-J-1 


< IOOUT,89O0> 
< IOOUT,9000> 


ABS0351 0 
ABS03520 
ABS 03530 
ABS 03540 
ABS0355  0 
ABSOSSeO 
AB30357O 
A6S03580 
ABS03590 
ABS03600 
ABS0361 0 
ABS 03620 
ABS0S630 
ABS 03640 
ABS03650 
ABS03660 
ABS036>'  0 
ABS036S0 
ABS 03690 
ABS03700 
ABS037i 0 
ABS03720 
ABS03('3u 
ABS03740 
ABS03750 
ABS03760 
ABS0377U 
ABS037S0 
ABS03790 
ABS03800 
AB$03d1 0 
ABS 03820 
ABS03830 
ABS03840 
ABS038S0 
AB&03860 
ABS03870 
ABS03880 
ABS03890 
ABS 039 00 
ABS0391 0 
ABS03920 
ABS03930 
ABS03940 
ABS039S0 
ABS03960 
ABS03970 
AeS03980 
ABS03990 
ABS04000 
A6l0401  0 
ABS04020 
ABS04030 
ABS04040 
ABS04050 
ABS04060 
ABS04070 
ABS040S0 
ABS04090 
ABS04t  00 
ABS041 1 0 
ABS04120 
ABS04130 
ABS04140 
ABS041S0 
ABS04160 
ABS04170 
ABS04180 
ABS04190 
AB304200 
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PH=180.0-  ASIN<  SPHI  i/'CP 

TS=Sk 

PS^PSI 

DO  5300  K=1 , KMhX 
53  0  0  E<K)=VH<K> 

00  TO  4500 
5400  BETh=2 , ♦BETA-8 
PSI=P . *851-85 
3R=2 . *SR-T5 

L  LONG  PATH  TAKEN 

PHI=PH 

DO  5500  K=t,KMAX 
5500  VH<K>=2.*VH<K)-E<K) 

GO  TO  5800 

5t.0  0  DO  57  0  0  K=1,KMA^ 

5700  VH<K)=2. 0*VH<K) 

BETA=2 . 0*BETA 

IF  <H2,EQ.H1 >  GO  TO  5800 
S8HI=5IN<  AHGLE*CA ) 

GO  TO  2600 
5800  COHTINUt 

DO  5900  K=1,KMAy 
U<K)=>VH<K) 

5900  CONTINUE 
6000  CONTINUE 
6i00  RETURN 

^6200  FORMAT  <7F10.3) 

6250  FORMAT  <2FiO,3,12:) 

6300  FORMAT  <1H0,9X,4H  HI F7 . 3, 6HKM, H2=, F7 . 3, 9HKM, ANGLE=, 

1  F8.4, 13HGE0M.  RANGE  * , F7 , 2, 8HKM, BETA= , F8 . 5 , 

2  5H,VIS=,F6. 1  ) 

6400  FORMAT  < 3F 1 0 . 3. 2F5 , t , 2E 1 0 . 3, 2F 1 0 , 3 ) 

6500  FORMAT  < 1  OX, 26HINPUT  METEOROLOGICAL  DATA;/1 0X,2H7=, 


1 

2 

3 

4 

5 


F7,2,7H  KM,  P«,F7.2,6H  MB, T-, F5 . I , 8H  C,  DEW 
7HPT.TEnP,F5. 1 , 17H  C,  REL  HUMlDITYs, F5 . 1 , 

I6H  X,  H20  DENSITY®, 1PE9. 2, 7H  GM  M-3/J0X, 

15H  OZONE  DENSITY=,E9.2,20H  GM-3,  VISUAL  RANGE® 
,0PF6.1,10H  KM, RANGE®, FI  0.3, 4H  KM  > 

<24H  MODEL  ATMOSPHERE  NO.  7,X4X,6HZ  <KM>,3X, 

6HP  <MB),4X,30HT  <C)  DEW  PT  XRH  H20(CM.M-3>  , 
19H03<GM,M-3)  NO.  DEN.) 

6700  FORMAT  <XX10X,28H  HORIZONTAL  PATH,  ALTITUDE  =,F7,3, 

1  11 H  KM, RANGE  ®,F7,3,3H  KM > 

6800  FORMAT  <X/10X,37H  SLANT  PATH  BETWEEN  ALTITUDES  HI  AND  , 
13HH2  WHERE  HI  »,F7.3,8H  KM  H2  =,F7.3, 

18H  KM, ZENITH  ANGLE  =,F7.3,8H  DECREES > 
<XX10X,39H  SLANT  PATH  TO  SPACE  FROM  ALTITUDE 
,F7,3,19H  KM,  ZENITH  ANGLE  =,F7,3, 

8H  DEGREES) 

7200  FORMAT  </’20X,18H  MODEL  ATMOSPHERE 
7300  FORMAT  <X20X,ieH  MODEL  ATMOSPHERE 
1  21H  =  MIDLATITUDE  SUMMER) 

7400  FORMAT  </20X,iaH  MODEL  ATMOSPHERE 


6600  FORMAT 
1 

2 


1 

2 

6900  FORMAT 
1 

2 


,11,  11H 
,11, 


HI 


TROPICAL) 


1 

7500  FORMAT 
1 

7600  FORMAT 
1 


,11. 


,  II  ,  1 1H 


21H  =  MIDLATITUDE  WINTER) 
<X20X,18H  MODEL  ATMOSPHERE 
7HfUMMER  ) 

<720X,18H  MODEL  ATMOSPHERE 
7HWINTER  ) 

7700  FORMAT  <X20X,18H  MODEL  ATMOSPHERE 
1  1 OHSTANDARD  ) 

7800  FORMAT<y20X, leH  MODEL  ATMOSPHERE 
1  16H<YEAR,  DAYTIME)  ) 

7900  FORMATC/ZOX, 18H  MODEL  ATMOSPHERE  ,11,20H 
1  18H<YEAR,  NIGHTTIME)  ) 

8000  FORMAT  <X10X,21H  FREQUENCY  RANGE  VI®  ,F7 

1  4HV2=  ,F7.1,14H  CM-1  FOR  DV  -,F6 

2  ,F6.2,3H  -  ,F5.2,I0H  MICRONS  >) 


,11, 14H  =  SUB-ARCTIC 
,  II , 14H  =  SUB-ARCTIC 


1962  US 


,  II.ZOH  =  ISRAELI  STANDARD 


ISRAELI  STANDARD 


1 ,9H  CM-1 
1 ,9H  CM-1 


TO 


AeS042) 0 
ABS04220 
AB504230 
AB5 04240 
AB604250 
ABS04260 
AB50427  0 
ABS042&0 
ABS0429U 
ABS04300 
A6S0431 0 
ABS04320 
ABS 04330 
ABS04340 
A8504350 
ABS 04360 
ABS04370 
ABS 04380 
AB504390 
ABS 044 00 
ABS 0441 0 
ABS 04420 
ABS04430 
ABS04440 
ABS04450 
AB&04460 
ABS0447U 
ABS04480 
ABS04490 
ABS04500 
ABS045t  0 
ABS04520 
ABS04530 
ABS04540 
ABS04550 
ABS04560 
ABS04570 
ABS04580 
ABS04590 
ABS04600 
ABS0461 0 
ABS04620 
ABS04630 
ABS04640 
ABS04650 
ABS04660 
ABS04670 
ABS04680 
ABS04690 
ABS04700 
ABS0471 0 
A6S04720 
ABS04730 
ABS04740 
ABS04750 
ABS04760 
ABS04770 
ABS04780 
ABS04790 
ABS 048 00 
ABS0481 0 
AB304820 
ABS04830 
ABS04840 
ABS04850 
ABS04860 
ABS04870 
ABS04880 
ABS04890 
ABS04900 
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aiuO  t-uRrlHT 
3200  FORMftT 
1 

2 

3300  FORMAT 
8400  FORMAT 
t 

8500  FORMAT 
8600  FORMAT 
8700  FORMAT 
1 

8800  FORMAT 
1 

Oy 0  0  FORMAT 
1 

2 

9000  FORMAT 
1  _ 
tNL) 


<;  1  H  t  , /'/'/i  OX  ,  2uH  HORIZONTAL  f'KOFILtbX> 

< 38H  TRAJECTORY  MISSES  EARTHS  ATMOSPHERE.  , 
3tHCL0SEST  DISTANCE  OF  APPROACH  I S . F 1 0 . 2 . 1 X . / 
,1X,18HEND  OF  CALCULATION) 

<  1  X.  14, F6 . 1 >  t  2<  E9 . 3  >  ) 

<  1H1  0X,21H  VERTICAL  PROFILES  ,53X,3HPSI, 

6X, 3HPHI , 6X, 4H8ETA,3X. 13HTHETA  RANGE  > 

<  I3,F6 , 1 , 7E»  0 . 3, 4F9 .4,F6 . 1  > 

<8H  HMIN  =  , FI  0.3) 

<40H  H2  WAS  SET  LESS  THAN  HMIN  AND  HAS  BEEN  , 
34HRESET  EQUAL  TO  HMIN  I.E.  H2  =  , FI  0.3) 

<41H  PATH  INTERSECTS  EARTH  -  PATH  CHANGED  TO  , 
23HTYPE  2  WITH  H2  =  0.0  KM) 

<36H  CHOICE  OF  TWO  PATHS  FOR  THIS  CASE 
42HSH0RTEST  PATH  TAKEN.  FOR  LONGER  PATH  SET  , 
6HLEN=1  .  ) 

< 44H  CHOICE  OF  TWO  PATHS  FuR  THIS  CASE  -LONoEST 
41HPATH  TAKEN.  FOR  SHORT  PATH  SET  LEN  =  0  ) 


ABS049 i 0 
ABS 04920 
ABS04930 
ABS04940 
ABS04950 
ABS04960 
ABS04970 
ABS04980 
ABS04990 
ABS05C00 
ABS0501 0 
ABS05020 
ABS05030 
ABS05040 
ABS 05 050 
ABS 05 060 
ABSusOi'U 
ABS05080 
ABSOl-090 
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oooo 


SUBROUTINE  CKER  < V 1 , V2 , DV , I V 1 , I V2, lOV, lERR, MULOV, ISPOT 
LOGICAL  ISPOT 

COMMON  /lOUNIT/’IOlN,  lOOUT,  IPHFUN ,  LOUNIT,  NOIRTU,  NCL IMT , 
IERR=0 

IF  cMULDV.LE.  0>  MULDV*1 
;  CHECK  FOR  PROPER  WINDOW  REGION 

IFt V2 , LE . 830 . 0 J  GO  TO  1090 

IF  < VI .GE. 1250. 0. AND, V2.LE.201 0. 0>  GO  TO  1090 
IF  < VI  .GE . 3330 . 0 . AND . V2.LT .501 0. 0>  GO  TO  1090 
IF  <V1 .GE. 39990. 0)  GO  TO  1090 
GO  TO  1100 

1090  WRITE< IOOUT,3t90) 

TRAN=1 . 

IERR=1 

RETURN 

:  CHECK  FOR  PROPER  INTEGER  VALUES 

I  1  00  IV1=20fIFIX<:<  VI-1  0. 0)/'20. 0>+l  0 

IV2=2  0>t.lFIX<  <  V2-1  0 . 0)/20 . 0+0 .99  >+1  0 
IF  < IV1 .LT.830>  IV1=830 

IF  < IV1 .LT. 1250. AND. IV2,GT. 1250>  IV2=1250 
IF  < IV1 .LT. 2010. AND, 1V2.GT.2010>  IV1*2010 
IF  < IV1 .LT. 3330. AND. IV2.GT. 3330)  1V2=3330 
IF  <IV1 ,LT. 5010. AND. IV2,GT. 5010)  IV1=5010 
IF  < IVl .LT. 39990. AND, IV2.GT. 39990)  IV2=39990 
VI=FLOAT< IV1 ) 

V2=FL0AT< 1V2) 

DV=20.*FLOAT<MULDV) 

IWVCk»=0 

IDV=IFIX<DV) 

WHEN  CALLED  FROM  SPOT  CHECK  FOR  MORE  THAN  15  DIVISIONS 
<16  WAVENUMBER  VALUES)  WHICH  IS  ARRAY  SIZE. 

CHECK  HERE  FOR  ROUNDING  PROBLEMS  ON  VI.  V2  CAUSING 
TOO  SMALL  AN  INCREMENT 

IF  < ISPOT. AND. <FLOAT< IV2-IV1 )X15. ,GT.<FLOAT< IDV)+. 001 ) 
IF  <  IWVCK.NE. 1  )  GO  TO  91 
CKDV=FLOAT< IV2-IV1  )X< 15.+20,  ) 

MULDV=IFIX<CKDV) 

IF  <FLOAT<MULDV)/CKDV.LT, ,99)  MULDV=MULDV+ 1 
DVHOLD=20  .  t«FLOAT<  MULDV  ) 

WRITE  <I00UT.93)  DV.DVHOLD 
DV=DVHOLD 

IF  <DV.LT.20. )  DV»20. 

IDV=IF1X<DV) 

?3  FORMAT  < IX.  'DIVISION  LIMITS  CHANGED  FROM  '.FI  0.3, 

+'  TO  ',F10.3) 

)1  CONTINUE 
RETURN 

3190  FORMAT  <  6X.  '♦♦**i<*FREQIJENCY  IS  OUTSIDE  OF  THE  WINDOW** 
1  6X.  '******T0TAL  TRANSMITTANCE  IS  1.0  0  0  0******' 

END 


1 , 0000****** ' 


.TRAN)  CKR00010 

CKR00020 
KSTOR.NPLOTUCKR 00030 
CKR00040 
C'KROOOSO 
CKR00060 
CKR0007O 
CKR00080 
CKR00090 
CKR001 CO 
CKR001 1 0 
CKR00120 
CKR00130 
CKR001 40 
CKR001S0 
CKR001 60 
CKR00170 
CKR00180 
CKR00190 
CKR00200 
CKR0021 0 
CKR00220 
CKR00230 
CKR00240 
CKR00250 
CKR00260 
CKR00270 
CKR00280 
CKR00290 
CKR00300 
CKR0031 0 
CKR00320 
CKR00330 
))  IWVCK*1  CKR00340 
CKR00350 
CKR00360 
CKR00370 
CKR00380 
CKR00390 
CKR00400 
CKR0041 0 
CKR00420 
CKR00430 
CKR00440 
CKR00450 
CKR00460 
CKR00470 
«>i.4<H<V  CKR00480 

)  CKR00490 

CKR00500 


6 

7 

8 
9 

1  0 

1 1 

12 
1  3 

14 

15 
1  b 

13 

19 

20 
21 
22 

23 

24 

25 
35 

26 
27 


bUBROUTIHE  FREQaLc  I ,  iV,  iJ,  Tj<> 

COnnON  /'M05/  CUSCI  >,C2<258),C3<86>,C4<33),C5<6),C5DUI1<9>,C8':82>, 
1  Cl  1<4  ),C12<  15),C14<:21  >,Ct5<6> 

COMMON  /M07/  TR< 67 ) , FU< 67 ) , FO< 67  ) 

COMMON  /’M087SUM4,  SUMS,  SUMS,  SUM  1  1  ,SUM6 
DIMENSION  UK  16),TX<  16> 

IF  <  I  .EQ. 1  >  GO  TO  10 
IF  <  I  .GE.2.AND. I .LE.3>  GO  TO  1  1 
IF  <  I  ,GE.4.AND. I .LE.Sj  GO  TO  12 
IF  < I .GE.6.AND, I .LE. 12>  GO  TO  13 
IF  < I , GE , 1 3 . AND . I . LE . 21 >  GO  TO  15 
IF  <  I  .  EGi .  22  >  GO  I  0  16 

IF  << I .GE. 23. AND. I . LE . 59  > , OR . t I . GE . 127. AND. I .LE.209>)  RETURN 
IF  << I ,GE.60.AND. I .LE.63>>  GO  TO  14 
Ih  < I  .  GE . 64 . AND . I . LE . 76 >  GO  TO  IS 

IF  << I .GE. 77.AND. I .LE.ei  >.OR.< I .GE.87.AND. I .LE .96>)  GO  TO  13 
ii-  <  I  .  GE  .  S2  .  AND  .  I  .  LE  .  S6  >  GO  TO  3o 

IF  << I .GE.97,AND. I .LE. 101 >.OR,<I .GE. lOS.AHD. I  .LE.  109>>  GO  TO  14 
IF  < I . Gt . 1 02 . AND . I . LE . 1 04 >  GO  TO  9 
It  <  I  .  Gb  .  1  1  0  .  AND  .  I  ,  LE  .  1  1  2  >  GO  TO  21 
Ii-  i;  I  .  GE  .  1  1  3  .  AND  .  I  .  LE  .  1  23  >  GO  TO  22 

IF  < < 1 .GE. 1 24 . AND. I .LE. 126 >.OR .< 1 .GE.21 0. AND. I .LE . 363 > >  GO  TO  23 
Ib  < < I . GE , 364 . AND . I . LE . 41 9 > . OR . < I . Gt . 454 . AND . I . LE . 599 > >  GO  TO  24 
IF  <  < I .GE. 42  0. AND. I . LE .453 ).OR.< I .GE, 6 00 .AND ,  I , LE . 6 06 > . OR , < I , GE 
1 . 1 1 60 . AND . I . LE . 1 334 > >  GO  TO  35 
IF  < I .GE.607.AND. I .LE.609>  GO  TO  25 
IF  < I . GE . 61 0 . AND . I .LE . 621  )  GO  TO  26 

IF  <  < I . GE . 622 . AND . I . LE . 629  > . OR . < 1 . GE . 686 . AND , I . LE . 1 1 59  > . OR . < I . GE 
1 . 1335)>  GO  TO  27 

IF  < I .GE.630.AND. I .LE.685)  GO  TO  28 
CALL  H20VAP< I,W,C1 ,TX) 

GO  TO  40 

CALL  020NE<  I ,  Ul,  C3,  TX  :> 

CALL  UNIMIX<  I,UI,C2,TX) 

GO  TO  4 

CALL  N02< I,W,C15,TX) 

GO  TO  6 

CALL  H2041  0<  I,  IV,UI,C5,TX,SUM5> 

GO  TO  8 

CALL  NH3<  I,UI.C14,TX> 

GO  TO  9 

CALL  NITRIC';  I,W,C1  1  ,SUM1  1  ,TX> 

GO  TO  1 0 

CALL  NITRIC<:  I,U),C1  1  ,SUM1  1  ,TX) 

CALL  NH3<  I,U),C14,TX) 

CALL  H2041 0< I, IV,W,C5,TX,SUM5> 

GO  TO  6 

CALL  S02<  I,UI,C12,TX> 

GO  TO  13 

CALL  S02<  I,U(,C12,TX) 

GO  TO  14 

CALL  H2041  0<  I,  IV,UI,C5,TX,SUM5> 

CALL  NITRO< I,U,C4,TX,SUM4) 

GO  TO  6 

CALL  S02< I,W,C12,TX) 

GO  TO  19 

CALL  MOLSCT< IV,U,TX,SUM6) 

GO  TO  14 

CALL  HOLSCT< IV,U,TX,SUM6) 

GO  TO  6 

CALL  MOLSCTC IV,W,TX,SUM6i 
GO  TO  7 

CALL  MOLSCTC IV,W,TX,SUM6) 

GO  TO  4 

CALL  UHIMIX< 1,U,C2,TX> 

CALL  M0LSCTC1V,U,TX,SUM6) 

GO  TO  40 

CALL  UV0ZNE<I,W,C8,TX,SUM8> 

GO  TO  25 

CALL  UVOZNE< I,W,C8,TX,SUM8> 


FREuOul u 
FRE00020 
FRE00030 
FRE00040 
FRE00050 
FRE00060 
FRE00070 
FREOOOSO 
FRE00090 
FRE001 00 
FREOOl 1 0 
FRE00120 
FREOOl 30 
FREOOl 40 
FREOOl 50 
FREOOl  60 
FREOOl  70 
FREOOl 80 


FRE00200 
FRE0021 0 
FRE00220 
FRE 00230 
FRE 00240 
FRE00250 
FRE00260 
FRE 00270 
FRE00280 
FRE00290 
FRE00300 
FREOOSI 0 
FRE00320 
FRE00330 
FRE00340 
FRE00350 
FRE 00360 
FRE00370 
FRE00380 
FRE 00390 
FRE 004 00 
FRE 0041 0 
FRE00420 
FRE00430 
FRE00440 
FRE00450 
FRE00460 
FRE00470 
FRE00480 
FRE00490 
FRE00500 
FRE0051 0 
FRE00520 
FRE00530 
FRE00540 
FRE00550 
FRE 00560 
FRE00570 
FRE 00580 
FRE00590 
FRE00600 
FREO061 0 
FRE00620 
FRE00630 
FRE00640 
FRE 00650 
FRE 00660 
FRE00670 
FRE00680 
FRE00690 
FRE00700 
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CALL  HOLSCT< IV,W,TX,SUM6> 

GO  TO  40 

CALL  H20VAP< I,U,C1 ,TX j 
GO  TO  27 

CALL  H20410< I, I V, W, C5, TX. SUMS > 

GO  TO  20 

RETURN 

END 


FRE0071 0 
FRE00720 
FRE00730 
FRE00740 
FRE0075O 
FRE00760 
FREU0770 
FRE00780 


SUBROUTINE  H20VttP< I , W, C 1 , TX >  H2V0001U 

DIMENSION  CK501  ),TX<  1  >,W<  1  >  H2V00020 

C««i«i«««iii*«««!«iiti>ti**4>4<H<TRPNSMITTNNCE  FOR  UATER  VAPOR4<««>t<**H<««>t<«4>>f>)i«:4<««>«<4c>t<>ti«H2V00030 
IF  <W< 1 >.LT. 1 . OE-20)  GO  TO  500  H2V00040 

IF  <I.LE.22>  I1«I  H2V00050 

IF  < I .GE.60. AND. I .LE. 126 >  11=1-37  H2V00060 

IF<I.GE.210.AND.I.LE.419>  11=1-120  H2V00070 

IF< I .GE.454, AND. I .LE.599>  11=1-154  H2V00080 

IF  <I,GE.630>  11=1-184  H2V00090 

U)S1=AL0G1  0<W<  1  )>+C1<  11  >  H2V00100 

TX<  1  >=EXP<-1  0*t'<-1  .  14619+0. 55013*WS1  )  >  H2V00110 

500  RETURN  H2V00120 

END  H2v00150 


t 
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DUE  TO  4 . 6-4  ,  S  MICROhi 
1980. SPIE, VOL. 253. 261  . 


SUBROUTINE  H2041 0< I , IV. U, C5. TX. SUMS > 

C#+>*WATER  V8P0R  CONTINUUM.  3-5  AND  8-12  MICRON  REGIONS 
DIMENSION  C5(6  ).TX<5  ),UK  16> 

V=FLOAT< IV  > 

IF<I.OT.109)  GO  TO  100 
1F< I . GT . 22  >  GO  TO  200 

LE,  I  .LE, 22 1  CALCULATE  OPTICAL  DEPTH  DUE  TO  S-12  MICRON  CONTINUUM 
TX<  5  )=<  4 , 1  3+5578 . 0*EXP<  -7 . 87E-  03*V  >  >»W<  5  > 

GO  TO  300 
200  CONTINUE 

IF<i.LT.fa3>  GO  TO  100 
IF<I.GT,68)  GO  TO  400 
C*»*63 . LE . I . Lfc . 68 ! CALCULATE  OPTICAL  DEfTN 
C  +  +  *CuHTlNUUM , MODEL  FROM  BEH-SHALOM  ET  AL  . 

11=1-62 

TXc  5  >=C5<:  1 1  >*577 . 6*W<:  1  6  > 

GO  I  0  3  0  0 
400  CONTINUE 

IFf;  I  .  L  I  .  77  >  GO  TO  1  00 

C***77.LE. I .LE. 1 09: CALCULATE  OPTICAL  DEPTH  DUE  TO  3 . 3-4 . 3  MICRON 
C+**C0HT1NUUM .  MODEL  FROM  UATKINS  ET  AL , 1 979 . APPL . OPT . , VOL , 1 8 , 1 1 49 . 
V=V*1 . OE-03 
V2=V*V 
V3=V2*V 

CBURCH=46 . 4745-48 . 0698+V+ 1 6 . 398«*V2- 1 , 8321 7*V3 
CASL=-370 , 082+508 , 1 37*V-225 . 822*V2+32 . 7744+V3 
TX;  5  >=CeURCH*u(<;  1  0  )+CASL*Wt  1 5  > 

GO  TO  300 
100  T.X<5>=0.0 
300  SUM5=TX<5> 

IF<TX<5>.LT, 1 . 0E-05>  GO  TO  500 
IF<TX<5>.GT.20. d>  GO  TO  600 
TX<5>=EXP<-TX<5>> 

RETURN 

0 


500  TX( 5)=1  . 

RETURN 
60  0  TX<5)=0. 
RETURN 
END 


0 


H2F0001 0 
H2F00020 
H2F00030 
H2F00040 
H2F00050 
H2F00060 
H2F000:'0 
H2F000S0 
H2F00090 
H2F001 00 
H2F00i 1 0 
H2F00120 
H2F00130 
H2F00140 
H2F00150 
H2F001 60 
H2F00i70 
H2F00180 
H2F00i90 
H2F00200 
H2F0021 0 
H2F00220 
H2F 00250 
H2F 00240 
H2F 00250 
H2F 00260 
H2F00270 
H2F002S0 
H2F  0  0290 
H2F003u0 
H2F0031 0 
H2F 00320 
H2F0033U 
H2F00340 
H2F00350 
H2F 00360 
H2F00370 
H2F 00380 
H2F00390 
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SUBROUTINE  LTRhTH<  ULAY , WPrTH , TB6V, ANGLE , LEN, ITtPE , H 1 , N2, HOD 
COMHON  /m  1  /EH<  1  6 , 34  ),  P<  34  ),  T<  34  >,  WH<  34  >,  Z<  34  34  > .  RE ,  M . 

DIMENSION  WLAY<34, 1 6 ) , TBeY< 68 ) , UPATH< SB , 16 > 

COMMON  /EMI/HMIH.KMAX, I J, J1 , J2. JMIN, JEXTRA.NPI 
COMMON  /'EMZXUt:  1  6  ) ,  EC  1  6  ) ,  I L  ,  IKMAX,  LENTOR,  NLL 

COMMON  /'lOUNITXIOlH, lOOUT, 1 PHFUN, LOUNIT , ND IRTU , NCL I MT , KSTOR 
COMMON  /SPOTLO-MSPOT .L0READ,N16 
LOGICAL  ISP0T,N16,L0READ 
1L=0 

IF  <ITYPE.EQ.1)  GO  TO  1000 

IF  I ITYPE . EO , 2 . AND . Hi . EG , H2 >  J2=Ji 

IF  <H2.GT.H1  .AND.hNGLE.GT.SO. .AND.NP1 .EQ, 1  )  Jl  =  J1-i 
IF  < JEXTRA . EQ . 1 >  j2=J2+1 

IF  << ITYPE.EQ.2),AND.<H1 .GT.H2>.AND.<LEHT0R,EQ. 1  )>  J2= 

J2-1 

IF  <ITYPE.E0.3>  J2=HL 
IF  <.NQT.ISPOTi  URITt  <100UT,1200> 

DO  100  IK=1,68 


IF  <ITYPE.E0.3>  J2=HL 
IF  <.NQT.ISPOTi  URITt  <100UT,1200> 

DO  100  IK=1,68 
TBBY< IK  >=0. 

DO  100  K=1,KMAX 
WPATHC  ik,k:)=o, 

100  CONTINUE 
LEN=0 
NLL=NL-1 
IL=Ji ♦i 
IJ=IL+NLL 
Du  200  k=1,kMAX 
E':k>=o,_ 

200  CONTINUt 

IF  < ANGLE. GT. 90, 0>  GO  TO  300 

LEN^i . 

iL=Jl-l 

HMIN=1 . OE-6 

I  j=NLL 

300  CONTINUE 

DO  800  IK=1 ,68 
IF  <LEN,EO, 0>  IL=IL-1 
IF  <LEN.EQ. 1 >  IL=1L+1 
IJ=iJ-l 

IF  <  IL.EQ. 0)  GO  TO  800 
DO  4  00  K=*1,KMAX 
W<K)=E<K)+WLAY<  IL,K) 

WPATH<  IK,K)  =  W<K) 

400  CONTINUE 

IF  < IL.LE. O.OR.IL.GE.NL)  GO  TO  500 
TBAP=<T< IL)+T< IL+I  >>*0.5 

JEXTRA  IS  1  ONLY  WHEN  PROGRAM  NEVER  LEAVES  ONE  LAYER 
IF  <  .JEXTRA,  Ed.  1  >  TBAR=<T<  J1  >+T<  U1  +  1  >>*0,5 
500  CONTINUE 

TBBY'::  IK>=TBAR 
DO  600  K=t,KMAX 
E':k>=w<k> 

600  CONTINUE 

IF  < ANGLE. LE ,90. 0. AND. IL.EQ. NLL>  GO  TO  900 
IF  <  ITypt.£Q.3.AND,ANGLE.LE.50.0>  GO  TO  700 
IF  < ITYPE.EQ.3,AND.LEN.EQ.t .AND.IL.EQ, J2>  GO  TO  900 
ih  < ITYPE.EQ.2.AND.LENT0R.EQ. O.AND. IL.EQ. J2>  GO  TO  900 
IF  <  IL.EQ. JMIN. AND. HMIN.GT.O)  LEN=1 
IF  <  IL.EQ. 1 .AND, HMIN.LE. 0, 0)  GO  TO  900 
IF  <LEN,EQ, 0>  GO  TO  700 
IF  < IL.EQ. JMIN. AND. 10. EQ. IL+NLL>  IL»1L-1 
IF  < ITYPE,EQ.2.AND. IL.EQ. J2>  GO  TO  900 
700  CONTINUE 

IF  < .NOT. ISPOT)  WRITE  <IOOUT,1300)  IK.CWPATHC IK,K >,K» 

1  1 ,6>,WPATH< IK,8>,<WPATH< IK,K>,K-1 0, 14>,TBBY< IK> 

800  CONTINUE 
IKMAX=6S 
LEN=LENTOR 
RETURN 

900  CONTINUE 


EL  >  UTPOuOi 0 

NL  LTP00020 

LTP00030 
LTP00040 
LTP00050 
,  NPLOTULTP00060 
LTP00070 
LTP00080 
LTP00090 
LTP001 00 
LTPuul 1 0 
LTP00120 
LTPuul 50 
LTP00140 
LTPuOlSu 
LTP0U160 
LTPuul7u 
LTPC0130 
LTP001 90 
LTP0u2uu 
LTP0021 0 
LTPC0220 
L  I  P 0  023  0 
LTP 00240 
LTP0u25u 
LTP00260 
LTF00270 
LTP00280 
LTPuu29u 
LTPuOSOO 
LTPOujI 0 
LTP00320 
LTP0u330 
LTP00340 
LTP00350 
LTP00360 
LTP00370 
LTP00380 
LTP00390 
LTP00400 
LTP004i 0 
LTP00420 
LTP00430 
LTP00440 
LTP00450 
LTP 00460 
LTP00470 
LTP 00480 
LTPOu490 
LTP00500 
LTP 0051 0 
LTP00520 
LTP00530 
LTP 00540 
LTP0u55o 
LTP 00560 
L I P0u57o 
LTP00580 
LTP 00590 
LTPuOSuu 
LTP0061 0 
LTP00620 
LTPuu630 
LTP00640 
LTP00650 
LTP00660 
LTP00670 
LTP 00680 
LTP00690 
LTP00700 
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IF  <.NOT.ISPOT)  inlRITE  <IOOUT,1300>  IK,  <  UPPTH<  IK,  k  >,  K  = 

1  1  ,6),gPATH< IK,8 >,< WPPTH< IK,K>,K=tO, 14),TBBVX  IK) 

IKMPX^IK 
LEN=LENTOR 
RETURN 

1  00  0  DO  1100  K=1  ,  KMh!< 

WPPTH< 1 ,K>=W<K> 

1100  CONTINUE 

IP  <rlODtL.EQ.0j  vi1  =  1 
J2  =  J1 

TBBV< 1  )=T<  J1  j 

1KMhX=1 

Ik=l 

IP  <.NOT,ISPOTj  WRITE  <100UT,1200) 

IF  <. NOT, 1  SPOT)  WRITE  <IOOUT,  1300>  I K , < WPPTH< I K , K  )  , K  = 

1  1,6  >,WPftTH< IK,8 ),<  WPPTHC IK,K),K=1 0, 1 4 >, TBBYC IK  ) 

HMIH=1 . OE-6 
RETURN 

^1  200  FORMAT  <  // ,  ,  3?H  CUMULATIVE  ABSORBER  AMOUNTS  FOR  THE  , 

1  16HATM0SPHERIC  PATH,/*/  8X ,  3HH20 , 5X ,  4HC02+ ,  6X , 

2H03,7X,2HN2,6X,5HH20  C,4X,5HM0L  S,4X,5H03  UV, 
4X,5HH20  C,5X,4HHN03,6X, 3HS02,6X,3HNH3 . 6X,3HN02, 
5X,4HTAVE) 

1300  FORMAT  < 1 5, 1 2E9 . 3 , F 1 0 , 3 > 

END 


LTPOOFi 0 
LTP00720 
LTP00730 
LTP00740 
LTP00750 
LTP00760 
LTP00770 
LTP00780 
LTPCI078  0 
LTP00800 
LTPOUbl 0 
L TP 00820 
LTPoOSSO 
LTP00840 
LTP00850 
LTP00860 
LTP00370 
LTP 00880 
LTP00890 
LTP0090C 
LTP0091 0 
LTP00920 
LTP00930 
LTP00940 
LTP00950 
LTP00960 
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SUBkOUTIHE  huLbCT<  I V ,  Ul ,  Tx ,  SUMb  > 
C******H.*i.TRflNSMITTANCE  FOR  MOLECULAR  SCATTERING 
C  Cb  EXPRESSION  MODIFIED  AS  PER  SHETTLE  ET  AL  ' 
C  28?: . 

DIMENSION  TX<b>,UI<6> 

V  =  FLOAT< IV  ) 

Cb=<  V*’t'4  9  ,  fa7578E+  1  S-1  .  t  1  a36E  +  09*V*>t*2  > 

T.X<  b  >  =  Cb’»'W<  b  '! 

SUMb  =  TX<  b  > 

IF  < TX< 6 > . EO , 0 . 0 >  GO  TO  200 
IF  <  rx<  b  > .  LE  .  0 . 1  ■)  GO  TO  100 
If  < TX< b > . GT . 20 . >  GO  TO  300 
TX<  fa  >=EXP< -TX<  fa  > i 
GO  TO  400 

1  00  TX<  fa  j  =  1  .  0-T;X(  fa  ;+0 . 5+TX?:  b  j^TXi  b  > 

GO  TO  400 
20  0  TX<  fa  >=1  .0 
GO  Tu  400 
300  TX<  b  j=0 . 0 
400  RETURN 
END 


nuLUOUi u 

SaO, APPL . OPT . , VOL . 1 9,  MOL00030 

MOL00040 
MOL00050 
MOL  0  0 06  0 
MOL  0  0 07  0 
MOL  0  0 080 
MOL  00 09  0 
MOL  001 00 
MOL  001 1 0 
MOL  001 2  0 
MOL  001 30 
MOL001 40 
MOL001 oO 
MOL  001 bO 
MOLOOI 70 
MOL  00  ISO 
MOL00190 
MOL  0  02 0  0 
MOL  0  021  0 


t 
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344 


SUBROUTINE  NITRi C< I , W, C H , SUM1 1 , TX >  NiTCOOiO 

DIMENSION  Ct I<4),TX< t f  ).W< 1 1  )  NITC0020 

TRANSMITTI^NCE  for  NITRIC  AC  I  +  *  +  +  003  0 


i  00 


HRBS=0 . 

IF  < I .LT.2, 

IF  < I .GT.5, 

11=1-1 

HRBS=C1 1<  1 1  > 
CONTINUE 

TX< 1 1  )=HABS*W< 1 1  ) 
SUM1  1=TX<:  1  1  ) 

IF  f;TX<  1  1  ).EO,  0, 0) 
IF  <  TX< 1 1 > , LE . 0 . 1 > 
IF  <TX< 1 1 >.GT.20. > 
TX< i 1 3=EXP< -TX< 1 1 >  i 
GO  TO  500 

TX< i 1 >=1 . 0-TX< 1 1 >+0 
GO  TO  500 
300  TX< i 1  )=1 . 0 
GO  TO  500 
TX< It )=0 . 0 
RETURN 
END 


OR . I , GT . 46  >  GO  TO  100 
AND . I .LT.23  >  GO  TO  100 


GO 

GO 

GO 


TO 

TO 

TO 


300 

200 

400 


2UU 


40  0 
50  0 


5f  TX<  1  I  )t.TX<  1 1  ) 


NITC0040 
NITC0050 
NITC0060 
NITC0070 
NITCOOSO 
NITCOOSO 
NITCOl 00 
NITCul 1 0 
NITC0120 
NITC0130 
N1TC0140 
N I T  C  0 1  5  U 
N I T  C  0 1  6  0 
NITCOl ?0 
NITC0180 
NITCOISO 
NITC0200 
NITC021 0 
NITC0220 
NITC023U 


C 
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oo 
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SUBROUTINE  NI TROC I , U. C4 , TX, SUM4  )  NITROOJO 

DIMENSION  C4<33>,TX<4),U<4>  NITR0020 

C*******»*TRANSMITTANCE  FOR  NITROGEN  CONT I NUUM****-*'*****  TR 003 0 


IF  <  I  .LT.64)  GO  TO  200 
1 1 »i -63 

TEMP  FIX  FOLLOWS 
IF  (Il.GT.IO)  GO  TO  300 
tx<4>=c4<  II  :)*wt:4> 

SUM4=TX<  4  > 

IF  k'TX<4).EQ.  0. 0)  GO  TO  200 
IF  <  TX<:  4  )  .  LE  .  0  .  1  >  GO  TO  100 
IF  ( TX<4 >. GT.20. )  GO  TO  300 
TX<4:>=EXP<-TX<4)> 

GO  TO  400 

100  I  X<  4  ■)=  1  .  0-TX<  4  >+0  .  S’cTXt  4  )*TX<  4  > 
GO  TO  400 
20  0  TXa  4  >=1  .0 
GO  TO  400 
30  0  TX<4)=0.0 
400  RETURN 
END 


NITR0040 
NiTR0050 
NITR0060 
NITROOTO 
NITR0080 
NITR0090 
NITftOI 00 
NITkOI 1 0 
NITR0120 
NITR01 30 
NITR0140 
NITR0150 
NITR0160 
NITR0170 
NITR0180 
NITROISO 
N1TR0200 
NITR021 0 


i 
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UI(V>—  oooooo 


SUBROUTINE  H02< I , W, C 1 4 , TX > 

COMMON  ,^M03/  FS<  9  ) .  S  U  9  ) . S2<  9  > , FNH3<  9  RHU  9 
1  OK  9  j,  02<  9  PPMS02,  PPMNH3,PPMN02 
DIMENSION  CI4<6),TX< 14>,W< 14) 

«  4««i >t< >)i IK <«•  O *>••«>•> I*  I! >)i4< *:«<«>•■*«« ’•"4I  4' W <•>« 4'>(<  4»l<  4< «>«< '4> « 

THIS  SUBROUTINE  CALCULATES  THE  TRANSMITTANCE 
THE  MAIN  PROGRAM). 

*%♦***♦  H.*  ***★♦♦  %♦%******•**  ♦in**  If***  ***>»*'*»i*%i*>»%** 

IE  < I .GE . 1 02 .AND. I .LE, 1 04)  I i =1-98 
IE  < I .LE.3>  11=1  , 

IE  < W< 1 4  ) . LT . 1 . oE-20 )  Gu  Tu  3 
WS14=AL0G1 Ot  W< 14 )>+C14< II ) 

DO  1  J=1 , 9 

IF  <US)4-FN02< J))  2>2>1 
CONTINUE 

TX<  14)«EXP<-iO**':01<  J)+02<  vt)*WS14>) 

RETURN 
END 


N02X001 0 

).FH2<9>,FN02<9),  N02X0020 

N02X0030 

N02X0040 

*%********i»i**>(i*!«mrK.*ni!*i*N02X0050 

N02X0060 

BY  N02  <  PPM  READ  IN  NO2X00?0 

N02X0080 

NCi2X0090 

4i<«>:f.«it!4i.4iX<<tcik>|i*%<t>>«>«>l<>t<’k*’f4tN02X0100 

N02X0i 1 0 
N02X0120 
N02X01 30 
N02X0140 
N02X0f 50 
N02X0160 
N02X0170 
N02X0180 
N02Xui90 
N02X0200 
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SUBROUTINE  020NE<  I ,  U,  C3 ,  TX  )  OZNOOfUO 

DIMENSION  C3<86>,TX<3>,W<3)  OZN00020 

ITtRNCE  FOR  OZONE***>»*»*-4<***^%x<ii>nmm<***i»im*i*.****OZN0  003  0 

IF  <  W<  3  )  .  LT  .  1  .  OE-20  :>  GO  TO  500  OZN00040 

IF  <  I.LE.22>  11  =  1  UZN00050 

IF  <I.GE.60>  11=1-37  OZN00060 

u(33=AL0G1  0<  W<  3  )  )+C3i:  1 1  )  OZN00070 

?i=1 1 +EXP< -3 . 0801  9+2 . 1  1  1  ZZ^WSZ  >  >  OZN00080 

SOOkETURN  0^:N00090 

END  OZNOOlOu 
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SUBROUTINE  POINT  <X,N,NP,TX>  POI 

COMMON  /'M01/'EH<  16,34),P<34),T<34>,UH<34),Z<34).WA<34>,RE,M.NL  POI 

COMMON  /EM1/HMIN,KMftX, IJ, J1 , J2, JMIH, JEXTRA.NPI  POI 

COMMON  /lOUNlT/IOIN. lOOUT, IPHFUN, LOUNI T , ND IRTU , NCL I MT . KSTOR , NPLOTUPO I 
COMMON  </SP0TL0/ISP0T,L0READ,N16  POI 

DIMENSION  TX<16)  PQI 

LOGICAL  ISP0T,N16,L0READ  puI 

Q  :«<  *  «  *  «  *  4>  >t> «  *  «  Hi  *  !•■  *  iok  *  *  Di  *  *  <«<  «>  Ik  4i  <ti4<  4<  *  *  Ik  4>  4: 4<  >«>  *  4i  *  iti  I*  *  *  «  4i  *  «  *  i4<  4i  i<t  4i  4>  >k  Hi  4<  !*•  H< « P  g  I 


SUBROUTINE  POINT  INTERPOLATES  EXPONENTIALLY  TO 
DETERMINE  THE  EQUIVALENT  ABSORBER  AMOUNTS  AT  THAT  ALTITUDE. 

X  IS  THE  HEIGHT  IN  QUESTION 

H  IS  THE  LEVEL  INTEGER  CORRESPONDING  TO  X  OR  THE  LEVEL  BELOW  X 
NP  »1  IF  X  COINCIDES  WITH  MODEL  ATMOSPHERE  LEVEL  , IF  NOT  NP  »  0 
TX<t-8)  ARE  ABSORBER  AMOUNTS  PER  KM  AT  HEIGHT  X 


POI 

POI 

POI 

POI 

POI 

POI 

POI 


33S 


(jalii|i«4i>X«ikikikikik  i(t4iikikikHiik4iikikm*ik4<ikikik*>k4«*”kikHi>k>k>k>kik*ik>k>kik<k*4t4''k>k*4>*ik*4>4i>kik*i*ikik'k>kikikik>ki*p0  I 

.  .  POI 

POI 
POI 
POI 
POI 
POI 
POI 
POI 
POI 
POI 
POI 
POI 
POI 
POI 
POI 
POI 
POI 
POI 
POI 
POI 
POI 
POI 
POI 
POI 


700 


N=NL 
NP=0 

IF  <X.LT.0.0)  X=0  . 

IF  <X,GT.Z<NL>>  GO  TO  400 

DO  i 00  1=1 , NL 

N=I 

IF  (:X-2<  I  :>)  200,400,  i  00 
1 00  CONTINUE 
200  J2=N 
N=N-1 

FAC=<  X-Z<  N  )  )/<  Z<  J2  ■;-2<  N  )  > 

DO  300  K=1 ,KMAX 

IF  <K.EQ.9.0R.K,EQ.7)  GO  TO  300 
TX<K>=0. 0 

IF  <EH<K,N).EQ. 0. 0>  GO  TO  300 
IF  <EH<K,N).GT. 1 000, 0)  GO  TO  300 
TX<  K  )=EH<  K ,  N  EH<  K ,  J2  )/EH<  K ,  N  )  )*h.FAC 
300  CONTINUE 
GO  TO  700 
400  NP=1 

DO  500  K=f,KMAX 
500  TX<K)=EH<K,N) 

RETURN 
END 


OOOt  0 
00020 
00030 
00040 
00050 
00060 
00070 
00080 
00090 
001  00 
00110 
00120 
00130 
00140 
OOtSO 
00160 
00170 
00180 
00190 
00200 
0021  0 
00220 
00230 
0  024  0 
0  025  0 
00260 
00270 
002S0 
00290 
00300 
0  031  0 
00320 
00330 
0034  0 
00350 
00360 
00370 
00380 
00390 
00400 
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FUNCTION  RESFN  <NR,UAVE>  RES0001 0 

THIS  FUNCTION  WILL  READ  IN  UP  TO  20  VALUES  OF  A  RESPONSE  FUNCTION  RES00020 
IF  THE  RESF  CARD  IS  READ  IN  EuMAIN.  ONLY  ONE  RESPONSE  FUNCTION  RES00030 
PER  RUN  IS  ALLOWED.  THIS  FUNCTION  WILL  ALSO  00  A  LINEAR  INTERPOLARES00040 
OVER  WAVELENGTH.  IF  RESF  CARD  IS  NOT  READ  A  VALUE  OF  1  IS  RETURNEDRE500050 
TO  THE  CALLING  PROGRAM  WHEN  THIS  FUNCTION  IS  REFERENCED.  RES00060 

COMMON  /•lOUNIT/IOIN, lOOUT , IPHFUN, LOUNIT, NDIRTU, NCLI MT/K3T0R .  NPLOTURES0u07  0 
DIMENSION  WAVELN<20),RESPFN<20>  RES00080 

DATA  UAVELN,RESPFN, ICOUNT,NBR  /2 0*0 . , 20* 0 . , 0 , 1 /  RES00090 

IF  CNR.NE.l)  GO  TO  6  RES00100 

IC0UNT  =  IC0UNT-«-1  RES00110 

IF  < ICOUNT .GT . f >  GO  TO  2  RESu0120 

READ  <IOIN,iOO>  NBR  RtSOOlSO 

IF  <NBR.GT,20)  WRITE  <IOOUT,102>  RES00140 

IF  <NBR.GT.20)  STOP  RESOOtSO 

WRITE  <IOOUT.103>  RES00160 

DO  3  1=1 ,NBR  RES00170 

READ  <r0IN,101)  MAVELN< I ), RESPFN< I >  RES00I80 

WRITE  <IOOUT,104)  WAVELN< I > , RESPFSK  I )  RES00190 

IF  <WAVE.LT.<WAVELH<  1  00  01  > . OR . WAVE . GT . < WAVeLN< NBR >+ . 0  001  >>  RES0  02  00 

+  GO  TO  6  RESu02i0 

DO  4  1=1, NBR  RES00220 

k=I  RES00230 

IF  <WAVE,GE.WAVELN<  I.  )>  GO  TO  5  RES0o240 

IF  <WAVE/UAVELNt'K>.G£.  .99.AND,WAVE/’WAVELN<k>.LE.  1  .  01  )  GO  TO  7  RES 00250 

IF  <K.EQ.NBR>  GO  TO  8  RES00260 

RESFN=(WAVE-WAVELN<k)>'*<<RESPFN<k+f  >-RESPFN<  K  >  >/  RES 0027  0 

1  <RESPFN<K+1  >-RESPFN<K:>>+RESPFN<K>  RES00280 

RETURN  RESU0290 

RESFN=RESPFH<K)  RES00300 

RETURN  RES00310 

RESFN=R£.SPFN<:NBR>  res  0  032  0 

RETURN  RES00330 

RESFN=1.  RES00340 

RETURN  RESO0350 

FORMAT  <I2)  RES 00360 

FORMAT  <2<E10. 4. IXi)  RES00370 

FORMAT  <1H  ,S1HTHE  NUMBER  OF  VALUES  FOR  THE  RESPONSE  FUNCTION  IS  GRES00380 
+,58HREATER  THAN  THE  DIMENSIONS  LIMITS  OF  UAVELN<  )  AND  RESPFN<  ),  RES00390 

IX, 19HPR0GRAM  TERMINATED.)  RES00400 

FORMAT  <1H  , 20X,23HIHPUT  RESPONSE  FUNCTION, /, IX, 15X, 1 0HUAVELENGTH,RES0041 0 
+5X,10HR  FUNCTION)  RES00420 

FORMAT  <IH  , 15X,2<Et 0.4, IX))  RES00430 

END  RES00440 
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SUBROUTINE  302< I , U, Cl  2, TX > 

COMMON  XM03/  FS< 9 >. SI < 9 >, S2< 9  ),FNH3< 9 >, FH1< 9 
1  0 1 <  9  > , 02<  9  > , PPMS02 , PPMNH3 , PPMN02 
DIMENSION  C12<  15),TX<  12).U<  12) 

C  «  Diiti  4> 41  <*  >k  41 4< «  Xi III  4>  ■)■<*«<*  41  <l> %  4>  4>  ■tiO  ^  >0  4>  4i  4>  4i 41  «>>•■  4>  I* «  m Ik  *  Dt 

THIS  SUBROUTINE  CALCULATES  THE  TRANSMITTANCE 
THE  MAIN  PROGRAM). 

4i4i4i  4i4i4i4i4i4i4!4i4i4l4i4i4i4i4i4i4i4i4l4i4i4i4i4i4i4i4i4i4l%4i4i4i4i4i4i4i4i4i4i4l4i4i4i4i4i 

IF  <  iJ<  12  > .  LT  .  i  ■  OE-20  )  GO  TO  5 
IF  < I .GE. t3.AND. I .LE.22)  11al-12 
IF  < I . GE . 82  i  11=1-71 
WS12=AL0G1 0<M< 12))+C12( 1 1  > 

Du  i  j=1 , 9 
IF<WS12-FS< J))  2,2, f 
CONTINUE 

TX<  1  2  )=EXP<  - 1  O**!.  S 1  <  J  )+S2<  J  )4iWS  1 2  >  > 

RETURN 
END 


SO2X00i 0 

),FH2<9),FN02<9),  S02X0020 

S02X0030 

S02X0040 

4i4i4i4i4i4i4i4i4i4i4i4i4<4i4i4i4i4i4i4<4i4<3O2X00S0 

S02X0060 

BV  S02  <  PPM  READ  IN  S02X0070 

S02X0080 

S02XOOSO 

4i4i  4.41  4<4i4i4i4i4i4t4i  4141 4i4i4l4i4i4i  4i4i302XO  1  00 

S02X01 1 0 
302X0120 
302X0130 
302X0  MO 
302XOiSO 
SO2X01S0 
S02X0170 
302X01 80 
302X0190 
302X0200 


UKII  0001  0 
UNI00020 

GASES’***’*=*’**’**’<'’*'’*'*UNI  00030 
UNI  0  0040 
UNI  00050 
UNI00060 
UNI0OO?O 
UNIOOOSO 
UNI  00090 
UNI  001 00 
UNI  001 1 0 
UNI00120 
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SUBROUTINE  UVOZNEf I , W, CS, TX, SUMS > 

DIMENSION  C8<82>,TX<8),W<8> 

C=«.w****»-*  TRANSMITTANCE  FOR  UV  OZONE  ♦»***>»*»•***» 
AI  =  I 

IF< I .LE. 1159)  GO  TO  90 
IF  < I.CE.1335>  GO  TO  100 
XX=1 0 . 0 

XI=< AI-61 0. 0>/XX+l . 0 
Ll*1 
L2=53 
GO  TO  200 
XX=25. 0 

XI=<  Hi- i 335 . 0 )XXX+57 . 0 
Ll=57 
L2=i 02 

DO  300  N=L1 ,L2 
XD=XI-FLOAT<N> 

IF  <XD>  500,400,300 
CONTINUE 

TX<8)=U<8>*C8<N> 

GO  TO  bOO 

TX<8  )=C8<N)+XD*<C8<N>-C8<N-1  )) 

TX<:  8  )=IJ<  8  j^fTX^  8  ) 

SUM8=TX<8;) 

IF  < TX< 8 > . EQ . 0 . 0 )  GO  TO  800 
IF  <TX<8).LE. 0. 1 )  GO  TO  700 
IF  <TX(8).GT.20.0)  GO  TO  900 
TX<8>=EXP<-TX<8)> 

GO  TO  1000 

TX<8)=1  .  0-TX<8)+0,5*TX<8)>*TX<8> 

GO  TO  1000 
TXC  8  >=  1  ,  0 
GO  To  1000 
TX<8  )=0, 0 
RETURN 
END 


90 


1  0  0 


200 


300 
40  0 

50  0 

bOO 


70  0 

800 

900 

1000 


UVZ0001 0 
UVZ00020 
*<<■>•■  W>Ki'«:<l>*UVZ  0  0  03  0 
UVZ00040 
UvZ00050 
UVZ00060 
UV200070 
UVZ00080 
UVZ00090 
UVZOOl 00 
UVZOOl 1 0 

Livzoorzo 

UvZOOl 30 
UVZ00140 
UVZOOl 50 
UV200160 
UV200170 
UVZ00180 
UV200190 
UVZ00200 
UVZ0021 0 
UVZ00220 
UVZ 00230 
UVZ00240 
UVZ00250 
UVZ00260 
UVZ 00270 
UV200280 
UvZ00290 
UV200300 
UVZ0U31 0 
UVZ 00320 
UV200330 
UVZ 00340 
UV200350 
UVZ 00360 


t 
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SUBROUTIME  SPOKUAVNI  ,  UAVN2,  VIS,  NR,  IERR,MULDV>  SPOT001  0 

INPUT;  EXCLUDING  THE  OPTIONhL  RESPONSE  FUNCTION  CARDS,  SPuTOOSO 


THERE  IS  A  MAXIMUM  OF  7  CARDS  TO  EXECUTE  THIS  MODULE, 

THE  CARDS  MAV  BE  INSERTED  IN  ANY  ORDER  WITH  THE  EXCtPTION  OF 
THE  LAST  CARD  WHICH  SIGNIFIES  THAT  EXECUTION  IS  TO  BEGIN, 

THE  CARDS  ARE  INPUT  WITH  FORMAT  c A4 , 6X, 7E1 0 . 4 > 

EACH  CARD  BEGINS  WITH  A  4  LETTER  IDENTIFIER  IN  COL  1  -  4 
FOLLOWED  BY  AS  MANY  <REALj  FIELDS  AS  NEEDED,  10  COL  PER 
FIELD  BEGINNING  IN  COL  11. 

THE  CARDS  ARE  NOT  ORDER  DEPENDENT. 


CARD  1 
ENVR 


I30RC,  ITARG,  IHAZE,  MODEL,  NLAM 


ISORC  = 


ITARG  = 


0  SUNLIGHT  ONLY 

1  MOONLIGHT  ONLY 

2  EMISSION  ONLY 

3  SUNLIGHT  AND  EMISSION 

4  MOONLIGHT  AND  EMISSION 

0  backgkgund  only 

1  GROUND  REFLECTANCEXEMISSION 

2  TARGET  REFLECTANCEXEMISSiON 


SPOT0040 
SPOT  0050 
SPOT0060 
SPOT  0070 
SPOT0080 
SPOT  0090 
SPOT01 00 
SPOT  01 1 0 
SPOT01 20 
SPOT  0130 
SPOT0140 
SPOT0150 
SPOT01 60 
SPOT0170 
SPOTOieO 
SPOT0190 
SPOT  0200 
SPOT021 0 


AEROSOL  ATTENUATION  LIMITED  TO  4  KM  BASE  HEIGHT  AND  500  M  THICK  ■**SPOT0220 


t-OR  SLANT  PATHS  IHA2E  =  1,2,  OR  3  ARt  THE  ONLY  ALLOWED  VALUES. 
IHA7E  =0,NO  AEROSOL  ATTENUATION 
=1 ,  MARITIME  POLAR 
=2,  MARITIME  ARCTIC 
=3,  CONTINENTAL  POLAR 
»4,  RAIN 
=5,  SNOW 

=7,  USER  SUPPLIED  EXTINCTION  COEFFICIENT 
<READ  OH  ATM  CARD  -  SEE  CARD  3  BELOW) 

=8,  EXTINCTION  COEFFICIENT  WILL  BE  READ  FROM 
PHASE  FUNCTION  DATA  FILE 
MODEL  =  1  TROPICAL  MODEL  ATMOSPHERE 

2  MIDLATITUDE  SUMMER 

3  MIDLATITUDE  WINTER 

4  SUBARCTIC  SUMMER 

5  SUBARCTIC  WINTER 

6  1962  US  STANDARD 

8  ISRAELI  STANDARD  <YEAR,  DAYTIME) 

9  ISRAELI  STANDARD  <YEAR,  NIGHTTIME) 

NLAM  OPTION  FOR  AEROSOL  PHASE  FUNCTION 

=  0  NO  AEROSOL  ATTENUATION 

NE  0  READ  PHASE  FUNCTION  DATA  SET  -  ALSO  SEE 
ID  BELOW  AND  EXPLN  OF  PFN  DATA  SET  BELOW 
ID  PHASE  FUNCTION  IDENTIFIER 
=0,  USER  SUPPLIED 

»1,  MARITIME  ARCTIC,  VIS-0.1  TO  2.0  KM 

-2,  MARITIME  POLAR,  VIS=0,2  KM 

=3,  MARITIME  POLAR,  VIS-02,  KM 

=4,  CONTINENTAL  POLAR,  VIS-  0.2  TO  2.5  KM 

=5,  WHITE  PHOSPHORUS 

-6,  HEXACHLOROETHANE 

=7,  FOG  OIL 

-8,  DUST  < MODERATE  AEROSOL  LOADING) 

=9,  DUST  <HEAVY  AEROSOL  LOADING) 

-10,  MARITIME  MODEL  B.  VIS-5KM,  RH-95K 
-11,  MARITIME  MODEL  B,  VIS- 1 OKM , RH-90X 
-12,  MARITIME  MODEL  B,  VIS-50KM, RH-50X 


CARD  2 


SPOT  0230 
SPOT0240 
SPOT0250 
SPOT0260 
SPOT0270 
SPOT0280 
SPOT0290 
SPOT0300 
SPOT031 0 
SPOT  0320 
SPOT0330 
SPOT0340 
3POT0350 
SPOT0360 
SPOT  0370 
SPOT0380 
SPOT  0390 
SPOT0400 
SPOT041 0 
SPOT0420 
SPOT0430 
SPOT 0440 
SPOT  0450 
SPOT0460 
SPOT  0470 
SPOT0480 
SPOT0490 
SPOT0500 
SFOT051 0 
SPOT0520 
SPOT0530 
SPOT0540 
SPOT0550 
SPOT0560 
SPOT0570 
SPOT0580 
SPOT0590 


IF  ISORC  LT  2  OR  ITARG  LT  I  THIS  CARD  IS  NOT  NEEDEDSPOT0600 


[3  EM<1),  TM<1),  EM<2),  TM<  2 )  SPOT0610 

EM<1>  EMISSIVITY  OF  GROUND  SPOT0620 

TM< 1  )  TEMPERATURE  OF  GROUND  <KELVIN>  SPOT0630 

EM<2>  EMISSIVITY  OF  TARGET  SPOT0640 

TM<2)  TEMPERATURE  OF  TARGET  <KELVIN>  SPOT0630 

r^pis  7 

1  ZENTH,  CLDHGT,  PHASE, BETAEX  SPOT0670 

ZENTH  INCIDENT  ANGLE  OF  SUNLIGHT  OR  MOONLIGHT  < DEGREES  )SPOT0680 

CLDHGT  HEIGHT  OF  BOTTOM  OF  CLOUD  LAYER  < KM )  SPOT0690 


ONLY  NEEDED  WHEN  IHAZE  NE  0  < DEFAULT  IS  0.) 


SPOT0700 
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pHHbt  PHhSE  hNGLE  POR  HOOHLIGHT  <uEGREE5> 

BETAEX  USER  SUPPLIED  EXTINCTION  COEFFICIENT 

VhLID  only  when  IHH2E=7 

CARD  4 

ThRG  RTARG< COSX, cosy, C0S2 

RTARG  SLANT  RANGE  FROM  RECEIVER  TO  TARGET  < KM  ) 

COSX  X-DIRECTIOHAL  angle  of  target  NORMAL  <DEGREES> 

COSY  Y-DIRECTIONAL  ANGLE  OF  TARGEJ  NORMAL  < DEGREES  ) 

C0S2  2-DIRECTIONAL  ANGLE  OF  TARGE  i  NORMAL  ■iDEGREES  ) 

CARD  5  **>»*  IF  ITARG  LT  1  THIS  CARD  IS  NOT  NEEDED 

REFL  A0<  t  i,  A1  <  1  ),  lALBt  1  >,A0<2>,A1<2),  IaLB<  2  ) 

AO< 1 >  ALBEDO  COEFFICIENT  FOR  GROUND 

At<1>  ALBEDO  COEFFICIENT  FOR  GROUND 

IALB<0  TYPE  OF  REFLECTION  DISTRIBUTION  FOR  GROUND 
Au<2>  ALBEDO  COEFFICIENT  FOR  TARGET 

AK2>  ALBEDO  COEFFICIENT  FOR  TARGET 

IALB<2>  TYPE  OF  REFLECTION  DISTkIBUTIuN  FOR  TARGET 
lALB  =  0  LAMBERTIAN  REFLECTION  SURFACE 
1  ISOTkOPIC 

CARD  6 

SENS  ALT,  THETA,  PHI,  SANG2 

ALT  ALTITUDE  OF  RECEIVER  < KM  ) 

THETA  POLAR  DIRECTION  Oh  LOOK  ANuth  (DEGREES) 

PHI  AZMITH  DIRECTION  OF  LOOK  hnGLE  (DEGREES) 


♦  METEOROLOGICAL  AZIMUTH  CONVENTION  ASSUMED:  N  =  0  DEG. 

E  =  90  DEG,  S  =  130  DEG.  W  =  270  DEG  *t<**ih***=*'*>»«i*>h*ih*H<*i***h** 

SANG2  HALF  ANGLE  DEFINING  RECEIVER  FIELD-OF-VIEU 
(DEGREES) 

CARD  7 

GO  SIGNIFIES  TO  BEGIN  EXECUTION.  NO  MORE  INPUT  FOR 

THIS  CALL.  NOTE  THAT  IF  A  DATA  CARD  IS  NOT  READ 
THEN  ANY  VALUES  ESTABLISHED  FROM  PREVIOUS  CALLS 
TO  THE  MODULE  ARE  STILL  IN  EFFECT. 


SPOT  07 i 0 
SPOT  0720 
SPOT  0730 
SFOT074  0 
SPOT  0750 
3POT0760 
SPOT  0770 
SPOT  0780 
SPOT  0790 
SPOT0800 
SPOT  081 0 
SPOT0820 
SPOT  0830 
SPOT  084  0 
SPOT  0850 
SPOT  086  0 
SPOT  0870 
SPOT  0880 
SPOT  0890 
SPOT  09O0 
SPOT  09 i 0 
SPOT0920 
SPOT  0930 
SPOT  0940 
SPOT  0950 
SPOT  0960 
SPOT0970 
SPOT0980 
SPOT  099  0 
SPOT1 000 
SPOT 1010 
SPOT  1 020 
SPOT1 030 
SPOT  1 04  0 
SPOT  1 050 


SPOT  1 1 

OPTIONAL  CARDS  FOR  RESPONSE  FUNTION  (SET  BY  NR=1  IN  EOMAIN)  SPOTIi 

THESE  CARDS  MUST  FOLLOW  THE  GO  CARO  AND  CAN  ONLY  BE  INSERTED  ONCE  SPOTIi 

CARD  1:  NUMBER  OF  VALUES  FOR  RESPONSE  FUNCTION  -  FORMAT  (12).  SPOTii 

CARDS  2  -  NUMBER  OF  VALUES:  FORMAT  < 2< El  0 . 4 , 1 X >  )  SPOTl 

ONE  VALUE  OF  WAVE  <UM)  AND  RESPONSE  FUNCTON  PER  CARD  SPOTl 

N.B.  ONLY  ONE  RESPONSE  FUNCTION  PER  EOSAEL  RUN.  SPOTl 

SPOT  1 

AUXILLARV  READ  FROM  UNIT  IPHFUN  < ASL  DATA  SET  PROVIDED  WITH  EOSAEL >SP0T1 
ANG  ANGLES  AT  WHICH  PHASE  MATRIX  IS  DEFINED,  SPOTl 

NANG  VALUES  (DEFAULT  IS  65),  FORMAT< 1 1 < F6 . 2 , 1 X > >SPOT 1 
NANG. ID.WAVE.OMEGAO.BETAEX.BETABS  SPOTl 

NUMBER  OF  ANGLES  AT  WHICH  THE  PHASE  FUNCTION  HAS  SPOTl 
VALUES.  PFH  IDENTIFIER,  WAVELENGTH':  UM ),  SINGLE  SPOTl 
scattering  ALBEDO.  EXTINCTION  COEFFICIENTS  (TOTALSPOTI 
AND  SCATTERING).  SPOTl 

FORMAT  (2< 12. 1X),F5.2, 1X,F8. 6. 1X,2(E12,6, IX)).  SPOTl 
PF  PHASE  FUNCTION  AT  SPECIFIED  ANGLES,  SPOTl 

FORMAT  <6<E12,6. 1X>)  SPOTl 

LOGICAL  LI .L2,L3,L4,L5.L6,L7. ISP0T,N16,L0READ,H0RI2  SPOTl 

DIMEHSICN  DUMMY< 16)  SPOTl 

EQUIVALENCE  < ITARG. IT)  SPOTl 

COMMON  /ANSW2/TTR< 16),TBR( 16).CNTRST<16)  SPOTl 

COMMON  )'ALBEO/'AO<2).A1<2>,IALB<2>  SPOTl 

COMMON  XBKDAT/ALT, THETA, PHI, SANG2,ZENTH, PHASE, ALB  SPOTl 

COMMON  /’CCEOMZCOSGM,COSBT,  COSIN  SPOTl 

COMMON  ZCOMIl/'ISORC,  ITARG,  IWN,  JHL  SPOTl 

COMMON  /CONST/PI ,PI2,PIRa6,TWOPI, T0RRM8,CDEGK  SPOTl 

COMMON  XCTARG/RTARG, COSX, COSY, COSZ  SPOTl 

COMMON  XEMISS/'EM(2>,TM<2>  SPOTl 

COMMON  XIOUNITZIOIN, lOOUT , IPHFUN, LOUHIT , NDIRTU , NCLIMT , KSTOR , NPLOTUSPOT 1 
COMMON  /no  1 /EH< 16,34  ) , P<  34 ) , T<  34 ) , WH<  34 ) , 2<  34 ) , WA<  34  > , RE , M , NL ,  SPOTl 

■h  RRS<  16,34), SC6e<  16,34),  SPOTl 

+  TRANS< 16,5),RADA< 16,2),WAVE< 16>,SS< 16),  SPOTl' 
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1  DIR<  1  6  >,  RAOGx  1 6  >,  U7EM<  1 6  >,  UTRF(  1 6  Bk<  1  6 

2  PATHRC 16>,UERF< 1 6  ) . PATHR2< 1 6  > , TOTC 1 2  ) , BKG< 16  ) 

COMMON  /MOZ/  U0<34  ),RO,TBOUND, JP, IM,ML, IP, JSTOR 
COMMON  /EM2/W< 16), E< 16), IL, IKMPX , LENTOR , NLL 

COMMON  /SPOTLOX  ISPOT , LOREAD , N 1 6 

COMMON  /LOWEX/  WPATHC  68,  1  6  ),  ULAY<  34,  1  6  ),TBBY'r  68  )  ,  TX<  1  6  >,  BETAEX, 

1  CUDHGT,NCLD 

COMMON  XBASPOTX  ANG<  65  ) ,  StJM<  65  ) ,  WVL<  1 6  ) ,  NWVL ,  ALBBf  16),eS<  16), 

1  BEC  16),SIHGUV,PF<65),LMA.y 
COMMON  /LOGICXLI , L2 , L3 , L4 , L5 , L6 , L7 
DATA  LI  ,L2,L3,L4,L5,L6,L7/’7>*‘  .FALSE  ./ 

DATA  ITR1 , ITR2, ITR3, ITR4/2,3,5, 1/ 

N16« . TRUE. 

INBP=16 
DUM=1  . 

ICLMAT=0 
LOREAD= . TRUE . 

I3POT=.TRUE. 

C  INITIALIZE  AND  READ  INPUT  PARAMETERS 

chll  zero 

Call  indatc iemiss, ihaze, im,len, ml. model, 

1  TBOUHD, 0,CLDHGT,BETAEX  ) 

C  CHECK  FOR  ERROR  IN  INPUT  DATA 

IF  <  IHAZE. bU.S)  ItftR=-1 
IF  <IEftft,t0.1)  RETURN 
IF  <IS0RC.NE.2)  ISu)TCH=l 

C  FIRST  CALL  IS  TO  READ  LOUTRAN  DATA  FILE  ONLY 

CALL  LT4M< ALT,DUM,2ENTH,3, 0, TRANS< 1 , 1 ), DUMMY .DUMMY, 

1  IEMISS, LEN, MODEL, VIS,  V1,V2,TGRD, 

2  ICLMAT, lERR, NR, IHAZE, MULDV) 

V1=UAVH1 

V2=WAVN2 

CALL  CKER< VI ,V2,DV, IV1 , 1V2, IDV, lERR.MULDV, ISPOT.DUM  > 

WAVE< 1  )=1 OOOO.XVI 
DO  300  IU»2, IMBR 

V2=V  t  *20.  •*FLOAT<  MULDV  )*FLOAT<  Ui-1  ) 

IF  <V2.GE.'-JAVN2)  GO  TO  400 
UAVE< IW>=1 0000./V2 
300  CONTINUE 
LI*. TRUE . 

C  MAXIMUM  NO.  OF  WAVELENGTHS 
400  1WN=IW-1 

IF  <L1  >  IUN=INBR 
NWVL=IWN 

ARRAY  WVL  IS  USED  ONLY  IN  SUBROUTINE  PFUNC .  THE  WlAVELENGTHS 
IN  THIS  ARRAY  INCREASE  WITH  INCREASING  ARRAS’  INDEX.  THE 
VALID  RANGES  FOR  VALUES  IN  THE  WVL  ARRAY  ARE  :  0.2-2. 0,  3. 0-5.0, 
AND  8.0-12.0  MICROMETERS, 

DO  355  JX=«,NWVL 
INOM=NWVL-UX+l 
355  WVL< JX)=WAVE< IHOM) 

DO  500  1=1 ,NL 

IF  <ALT.LE.Z< I  ))  GO  TO  600 
500  CONTINUE 

WRITE  <IOOUT,3700)  ALT,I,Z<I> 

IERR=1 
RETURN 

600  CONTINUE 

IF  <I.EQ.l)  WRITE  <IOOUT,3800>  ALT 
IF  < I .EQ. 1  )  IERR  =  1 
IF  < lERR.EQ. t  )  RETURN 
JHL=I-1 
NLL=NL-1 

SAHG=TWOPI*<  1  .  0-COS<  SANG2>»PIRAD  )  > 

C2NTH=C03<2ENTH*PIRAD) 

S2NTH=S1H<  2ENTH*PIRAD ) 

CTHTA=iCOS<  THETA*P1RAD  ) 

STHTA=SIN<  THETA’tPIRAD  ) 


SPOT1 420 
SP0T143C 
SPOT1440 
SP0T1450 
SPOT1 460 
SPOT1470 
SPOT1 480 
SPOT1490 
SPOT1500 
SP0T151 0 
SPOT1520 
SPOT1530 
SPOT 1 540 
SPOT 1 550 
SP0T1560 
SPOT  1 570 
SPOT  1 5S0 
SPOT  159  0 
SPOT 1600 
SP0T161 0 
SPOT1620 
SPOT1630 
SPOT  1 640 
SPOT 1 650 
SPOT i 660 
SPOT  1 670 
SPOT  1 680 
3POT1690 
SPOT1700 
SPOT  171 0 
SPOT  1 720 
SPOT  1730 
SPOT1740 
SPOTi750 
SPOT1 760 
SPOT1770 
SP0T1780 
SPOT1790 
SPOT1800 
SP0T181 0 
SPOT1820 
SPOT  1830 
SPOT  1 840 
3POT1850 
SP0T1860 
3POT1870 
SPOT1880 
SPOT1890 
SPOT  1900 
SPOT  191 0 
SPOT1920 
SPOT  1 950 
SPOT1940 
SPOT1950 
SP0T1960 
SPOT1970 
SPOT1980 
SP0T1990 
SPOT2000 
SP0T20t  0 
SPOT2020 
SPOT2030 
SPOT2040 
SPOT2050 
SP0T2060 
SPOT2070 
SPOT2080 
SPOT2090 
SP0T21 00 
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CPmI=lDS(.  PH  I  I  PhD  > 

SPHI=SiNt:  PHI*PIRAD  > 

Ih  <  iSuftC  ,  EQ  .  2  .)  GO  TO  90  0 

C  CALCULATE  SOURCE  TERM  FOR  SUNLIGHT  <ISORC=0.3;) 

C  OR  MOONLIGHT  <I30RC=1,4> 

DO  700  IUI=1  ,  lUN 
SS< IW)=0. 0 

IF  <  ISORC.ECi,  O.OR.  IS0RC,Eu.3>  SS<  IW  >=SOLARS<  WAVE<  IW  >  > 

It-  <  ISORC  .  EQ  ■  1  .  OR  .  ISORC  .  tu  .  4  >  SS<  Iw  >=SMOOis<  uiAVE<  I  w  ) ,  PHASE  > 

700  CONTINUE 

C  CALCULATE  DIRECT  INTENSITV  ...  hOR  SUNLIGHT  CISORC=0,3> 

C  OR  MOONLIGHT  <1S0RC=1.4) 

C0SIN=STHTA*CPHI*S2NTH+CTHTA*C2NTH 
ANGIN=ACOS(:  COSIN  )/'PlRAD_ 

C  RhAD  PHASt  FUNCTION  hlLt 

CALL  INDAT< ItMISS, IHA2t. I M , LEH, ML , MODEL . 

1  TBOUND, 1 .CLDHGT.BETAEX) 

IF  <AHGIN,GT.SANG2)  L2  =  _^TRUE  , 
it-  c  2ENTH  .  G  I  .  80 . 0  )  L3=,iRUE. 

CALL  LT4M<  ALT,DUrl,  2EHTH.  3.  Oj  TRANSC  1  ,  1  >,  DUMMY,  DUrlMV . 

1  lEMISS.LEN, MODEL, VIS,  V1,V2,TGRD, 

2  ICLMAT, IERR,NR, IHA2E,MULDV) 

IF  <L2.0R.L3>  GO  TO  900 

DO  300  IW=1 , IWN 

DIR<  IU)=SS<  Ii«0*TRANS<  lU,  (  ) 

800  CONTINUE 

900  IF  < ITARG . EQ . 0 . AND . THETA , GT , 90 . 0 >  L7=,TRUE, 

IF  <L7>  GO  TO  3500 
It-  C  ITARG  .  EQ  ,  0  )  GO  TO  1200 
IF  <  ITARG.  EQ.O  GO  TO  1000 
C  TARGET . . , 

2TARG=RTARG*CTHTA-i-ALT 

COSTN=STHTA>'<CPHI 

C0STY=STHTA>»SPH1 

C0ST2=CTHTA 

C0SeT=C0SX-t'S2NTH-^C0S2*C2NTH 

CC'SGM=-<  COSTX*COS?<+COSTY’fCOSY+COST2^COS2  > 

IF  <THETA,LE.90, 0>  GO  TO  1100 
C0SBTG=C2NTH 

COSGMG=«COSt:  <180. 0-THETA  >i'PIRAD  > 

GO  TO  1100 
C  GROUND... 

1000  2TARG=0 . 0 

C03BT=C2HTH 

COSGM=COS<  <180. 0-THETA  >‘»PIRAD  > 

COSBTG=COSBT 

COSGMG*COSGM 

C  CALCULATE  ATMOSPHERIC  TRANSMISSI0N7RADIANCE  FOR  VARIOUS  PATHS 

1100  IF  <COSGM.LE. 0. 0>  L4=.TRUE. 

IF  <COSBT,LE. 0. 0>  L5=.TRUE. 

IF  <THETA. LE. 90. 0. AND, ITARG. EQ. 1  )  L6= . TRUE . 

IF  <L4.0R,L6>  GO  TO  3500 
1200  CONTINUE 

IF  < THETA, EQ. 90, 0> 

1  CALL  LT4M< ALT,DUM, 1 000, 0, 1 ,2,TRANS< 1 ,4>.RADA< 1 , 1 >, 

2  DUMMY,  IEMISS,LEN, MODEL, VIS,  VI, V2, 

3  TGFD, ICLMAT, lERR, NR, IHA2E,MULDV> 

IF  < THETA, EQ. 90. 0 . AND . I TARG . EQ . 2 ) 

1  CALL  LT4M< ALT, DUM, RTARG, 1 , 2, TRaNS< 1 ,2 ), RADh< 1 , 2 >, 

2  DUMMY,  lEMISS.LEN, MODEL, VIS,  VI , V2, 

3  TGRD, ICLMAT, lERR, NR, IHA2E,MULDV) 

IF  <THETA,EQ.90. 0>  GO  TO  1300 

IF  <THETA.LT.90. 0) 

1  CALL  LT4M<ALT,OUM,THETA,3,2,TRANS< 1 ,4>,RADA< 1 ,2>,DUMMV, 

2  IEM1SS,LEN, MODEL, VIS,  VI, V2, TGRD, 

3  ICLMAT, lERR, NR, IHA2E,MULDV> 

IF  <ITARG,EQ.0>  GO  TO  2000 

IF  <THETA.LT.90. 0) 

1  CALL  LT4M<ALT,ZTARG,THETA,2,2,TRANS< 1 ,2),RADA< 1 ,2> 

2  , DUMMY,  IEMISS,LEN, MODEL, VIS.  VI, V2, 


5P0T2 1 i u 
SP0T21 20 
SP0T21 30 
SP0T21 40 
3P0T21 50 
SP0T21 60 
3P0T21 70 
SP0T21 80 
SP0T2 1 9  0 
SPOT2200 
SP0T22 1 0 
SPOT2220 
SPOT2230 
3kOT2240 
SPOT2250 
SPOT2260 
3POT2270 
SPOT2280 
SP0T2290 
3POT2300 
SP0T231 0 
SPOT2320 
SF0T2330 
SPOT2340 
SPOT23S0 
SPOT2360 
SPOT2370 
SPOT2380 
SP0T2390 
SPOT2400 
3F0T24 1 0 
3POT2420 
SPOT^^SO 
SPOT2440 
SPQT2450 
SPOT2460 
SPOT2470 
SPOT2480 
SPuT2490 
SPOT2500 
SP0T25i u 
SPOT2520 
SPOT2530 
3POT2540 
SP0T2550 
SPOT2560 
3POT2570 
SPOT2580 
3POT2590 
SPOT2600 
SP0T2b1 0 
SPOT2620 
3POT2630 
SPOT2640 
3P0T2650 
SPOT2660 
SPOT2670 
SPOT2680 
3POT2690 
SPOT2700 
SP0T271 0 
SPOT2720 
3POT2730 
SPOT2740 
SPOT2750 
SPOT2760 
SPOT2770 
SPOT2780 
SPOT2790 
SPOT2800 
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3  TGRD, ICLMhT, IERR,NR, IHh2E.HULDV> 

IF  <THETA,LT.90, 0)  GO  TO  1300 

CALL  LT4r1<ALT,2TARG,THETA,2,2,TRANS<  1,2  >,  RADAc  1 

1  RADGk'O,  IEMISS,LEN,  MODEL,  VIS, 

2  TGRD, ICLMAT, I  ERR , MR , I HAZE , MULDV  > 
ITARG.NE.2)  ITR4=2 

,2)  GO  TO  1300 
,0,0>  ITR4=2 
,  0  .  0  >  GO  TO  1300 


2  >, 

VI , 


IF 

IF 

IF 

IF 


,  HE, 
,LE  , 
,  LE  , 


< ITARG . 

<2TARG , 

<  2TARG , 

ITR1=4 

CALL  LT4M‘;ALT,0.0,THETA,2,2,TRANS<1,4),RADA<  1 

1  RADG<1>,  lEMISS, LEM, MODEL, VIS, 

2  TGRD, ICLMAT, I ERR , NR , IHA2E , MULDV > 


1  >, 


1300  IF  <  ISORC 
CALCULATE 


LT.2)  GO  TO  1600 
UMCOLLIDED  EMISSION 


4  00 


1500 

1600 


DO  1500  IU=1 , lUN 

UIAVEM=WAVE<  IW  )/l  .  OE  +  4 

IF  <  ITARG . tu . 2 J  GO  TO  1400 

Bi<G<  lU  :)  =  eL  ACK<  WAVEM,  TGRD  >h.EM<  1  > 

RADG<  IUI>=RADG<:  IW  )*EM<  1  >‘fC.OSGMG 

BKC  lU  >=BKG<:  IW  ) 

UTEM<  IW  )=R,ADG<  IW  ) 

GO  TO  1500 

BK<  IW  >=BL.ACK<  WAVEM,  TM<  2  i  )‘»EM<  2  > 
UTEM<  IW)«=BK<  IW  >*COSGM-»TRANS<  IW,2> 
IF  (THETA. LE. 90. 0)  GO  TO  1500 
BKG(  IW:)=eLACK(  WAVEM,  TGRD  :>*EM<  1  > 
RADG< IW  )=RADG< IW  )*EM< 1  >fCOSGMG 
CONTINUE 

IF  <IS0RC.EQ.2';  GO  TO  2900 
CALCULATE  UNCOLL IDED  REFLECTANCE  . 


FROM 

OR 


GkOUND 

TARGET 


VI , V2, 


< ITARG=1  ) 
< ITARG=2  > 


FROM 

OR 


GROUND 

TARGET 


< ITARG=1 > 
<  ITARG=2  > 


IEMISS=0 
IF  <L5)  GO  TO  2000 
H0RZ2=*ABS<ZTARG-ALT),LT,  0.001 
IF(HORIZ)  ITR2=1 
IF<H0RI2)  GO  TO  1700 

CALL  LT4M<  2T ARG , DUM , 2EHTH , 3 , 2 , TRANS< 1 , 3 >, DUMMY , DUMMY , 

1  lEMISS.LEN, MODEL, VIS,  VI, V2, TGRD, 

2  ICLMAT, lERR, NR, IHAZE, MULDV) 

1700  IF  < 2TARG .LE , 0 . 0)  ITR3=ITR2 

IF  <2TARG.LE. 0. 0)  GO  TO  1800 
IF  (THETA. LE, 90. 0)  GO  TO  1800 

CALL  LT4M( 0. 0 , DUM, ZENTH , 3 , 2 , TRANS< 1 , 5 ) , DUMMY , DUMMY , 

1  lEMISS.LEN, MODEL, VIS,  VI, V2, TGRD, 

2  ICLMAT, lERR, NR, IHAZE, MULDV) 

1800  DO  1900  IW=1 , IWN 

ALB=ALBEDO( IT) 

UTRF(  IW)=SS(  IW)*COSBT*ALB>*TRANS(  IW,  2  >'»TRANS(  IW,  ITR2> 

IF  (THETA. LE. 90. 0)  GO  TO  1900 

UERF(  IW)=SS(  IW>*COSBTGt>ALBEOO(  1  >*TRANS<  IW,  ITRl  >* 

1  TRANS( IW, ITR3) 

1900  CONTINUE 

CALCULATE  SINGLE-SCATTERED  PATH  RADIANCE  . . . 

FROM  SUNLIGHT  (ISORC=0,3) 

OR  MOONLIGHT  (IS0RC=1,4) 

000  CALL  COEFS(P, T, VIS,  IHAZE, ZTARG,NCLD,IERR,BETAE1<) 

IF  (  lERR .LQ . 1  )  RETURN 

IF  ( ITARG, EQ.O)  GO  TO  2700 

CALL  PATHRD(CTHTA, ALT,RTARG, 1 , IHAZE, NR, 

1  IEMISS,LEN, MODEL, VIS, VI , V2 , TGRD, DUMMY, I CLMAT , MULDV ) 

DO  2100  IU‘=1,IWN 

2100  PATHR2( 1W)=SS( IW)fPATHR( IW) 

IF  ( ABS(CTHTA),LE. 1 . OE-3)  GO  TO  2600 
IF  (CTHTA.LT.O.O)  GO  TO  2300 
2200  Z2=Z(NLL) 

10=2 

RT-(  Z(  NLL  )-ZTARG  )/'CTHTA 
GO  TO  2800 


SP0T281 0 
SPOT2e20 
SPOT2330 
SPOT2840 
SPOT2850 
SPOT2860 
SP0T287U 
SPOT2880 
SPOT2S90 
SPOT2900 
SPUT291 0 
SPOT2920 
3POT2930 
SPOT2940 
SPCiT2950 
SPOT2960 
SPOT2970 
SPOT2980 
SPOT2990 
SPOT3000 
SPOT301 0 
SPOT3020 
3POT3030 
SPOT3040 
SPOT3050 
SPOT3060 
SPOT3070 
SPOTSOeO 
SPOT3090 
SP0T31 00 
SP0T31 1 0 
SPOT3120 
SP0T313U 
SPOT3140 
SPOT3150 
SPOT3160 
SPOT3170 
SPOT3180 
SPOT3190 
SPOT3200 
SP0T321 0 
SPOT3220 
3POT32jO 
SPOT3240 
SPOT323iO 
SPOT3260 
SP0T3270 
SPOT3280 
SPOT3290 
SP0T3300 
SP0T331 0 
SPOT3320 
SPOT3330 
SPOT3340 
SPOT3350 
SPOT3360 
SPOT3370 
SP0T3380 
SPOT3390 
SPOT3400 
SP0T341 0 
SPOT3420 
SPOT3430 
SPOT3440 
SPOT3450 
SPOT3460 
SP0T3470 
SPOT3480 
SPOT3490 
SPOT3500 
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2300  IF  ( ZTAkG . GT , 0 . 0 >  GO  TO  2500 
DO  2400  IW=1 j IWH 
24  0  0  PATHR<  lUI  >=0  .  0 
GO  TO  2500 
2500  22=0 . 0 
10=1 

RT=-2ThkG/’CTHTA 
GO  TO  2800 
2600  22=ZThRG 
RT=1 000. 0 
10=3 

GO  TO  2800 
2700  ItMISS=0 
ZTARG=hLT 

IF  <  hBS<  CTHTp  ■) ,  LE  .  1  .  OE-03  >  GO  TO  2600 
GO  TO  2200 

2800  CALL  PhTHRD<CTHTA.2ThRG.RT,I0, IH«2E,NR, 

1  lEMlSS.LEN, MODEL. VIS. VI . V2 . TGRD . DUMMY . I CLMAT . MULDV > 

C  CALCULATE  BACKGROUKD  AND  TOTAL  INTENSITY,  PLUS 

C  _  _  CONTRAST  RATIO 

2y00  DO  JlOO  IU=i,IUIH 

PATHR< IW)=PATHR2< 1W>+SS< IW>*PATHR< IW> 

TTR'i  lU  i=PATHR2<  lUi  j+UTRF<  lU  )+RADA<  lU,  2  >+UTEM(  IW  .) 

TBR':  IW  >=PATHR<  IW  >+UERF<  IW  )+RADA<  IW.  ITR4  >+RADG<  IW  > 

DIF  =  TTR< IW )-TBR< IW  j 

IF  ■;  TeR<  IW).GT.  0,  0>  GO  TO  3000 

IF  <  TTRt;  IW  )  .  EQ  .  TBR<  IW  >  >  CNTRST<  IW  >=U  .  0 

IF  <TTR< IW>,NE.TBR< IW)>  CNTRST< IW >=1 . OESO 

GO  TO  3100 

3000  CNTRST<  IW  >=DIF/'TBR<  IW> 

3100  CONTINUE 

C  CALCULATE  TOTAL  RADIANCES  INTEGRATED  OVER  DETECTOR  RESPONSE 
DV2=DVi>0 . 5 
SUMRPF=0 , 

DO  3200  IU=1 . IWN 
NW  =  1  0000 ./WAVE< IW  ) 

W2=1  00  00  .  /<  FLOAT<  NW  .)-DV2  ) 

W1  =  i 0000 ,7<  FLOAT<  NW  )+DV2  > 

IF  < IW.EQ, 1 )  W2=WAVE< 1  ) 

IF  < IW.EQ, IWN>  W1=WAVE<IWN> 

RESPFN=RESFN<NR.WAVE< IW)> 

SUMRPF=SUMRPF+RESPFN 

DW=<  W2-U1  >fRESPFN 

TOT< 1  >=TOT< 1 >+DW*UTEM< I«) 

TOT<  2  >=TOT<  2  J+DW^UTRF^ IW  > 

T0T<3)=T0T<3)-*-DW*RADA<  IW.2> 

TOT<  4  )=TOT<  4  )  +  DW*PATHR2< IW  ) 

T0T<5:)=T0T<5>+DW*TTR<  IW) 

TOT(  6  >=TOT<  6  >+DUI*R ADG<  I W  ) 

TOTC  7  )=TOT<  7  )+DW*UERF';  IW  > 

TOTC  8  )»TOT<  8  )+DU"*RADA<  IW.  ITR4  ) 

TOT<9)=tOT<9  )+DW*PATHR< IW) 

TuT< 1 0  )=TOT< 1 0  >+DW+TbR< IW  ) 

3200  TOT< 1 1  )=TOT< 1 1  >+DW*DIR< IW  ) 

IF  <WR.NE. 1 >  SUMRPF=1 . 

DO  3250  1=1.11 
3250  TOT<  1  )=TOT<  1  )/’SUI1RPF 

IF  <TOT< 1 0).GT. 0. 0)  GO  TO  3300 
IF  <T0T<5).EQ.T0T< 10))  TOT<i2)=0.0 
IF  (:T0T<5>.NE,T0T<  10))  TOT<  12)=1  .0E30 
GO  TO  3400 

3300  TOT<  12)=<T0T<5)-T0T<  1  0  )  )/TOT<  10) 

3400  CONTINUE 

3500  CALL  OUTPUT< MODEL, IHAZE.CLDHGT) 

RETURN 

C 

3700  FORMAT  <1H  ,11H  ALTITUDE  <,F10.3,17H>  GREATER  THAN  Z< , 

1  I2.2H>=,F1 0,3.27H  CONTROL  RETURNED  TO  MAIN 

2  1 OHFROM  SPOT .  ) 

3800  FORMAT  <1H  ,11H  ALTITUDE  <,F10.3,16H>  LESS  THAN  ZERO. 


SP0T351 0 
SPOT3520 
3POT3530 
SP0T3540 
SPOT3550 
SP0T3560 
SPOT3570 
SPOT35SO 
3POT3590 
SPOT3600 
SP0T561 0 
SPOT3620 
SPOT3630 
SPOT3640 
SPOT3650 
SPOT3660 
SPOT3670 
SPOT3680 
SPOT3690 
SPOT3700 
SP0T371 0 
SPOT3720 
3POt3730 
SPOT3740 
SPOT3750 
SPOT3760 
SPuT3770 
SPOT3780 
SPOT.J790 
SPOT3800 
SP0T3S1 0 
SPOT3820 
SPOT3S30 
SP0T3840 
SPOT3S50 
SPOT3860 
SPOT3870 
SPOT38eO 
SPOT3890 
SPOT3900 
SP0T391 0 
SPOT3920 
SPOT3930 
SPOT3940 
3P0T395U 
SPOT3960 
SPOT3970 
SPOT3980 
3POT3990 
SPOT4000 
3POT401 0 
SPOT4020 
SPOT4030 
SP0T4040 
3POT4050 
SPOT4060 
SPOT4070 
SPOT4  0SCI 
SPOT4090 
3P0T41 00 
3P0T41 1 0 
SPOT4120 
SP0T4 1 30 
SPOT4140 
SPOT4150 
SPOT4160 
SPOT4170 
SPOT4180 
SPOT4190 
SPOT4200 
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1  37H  CONTkOL  RETUftNEO  TO  MAIN  FROM  SPOT.)  SPOT42tO 

END  SPOT4220 
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FUNCTION  hLBEOO<:  I  > 

COMMON  /'ALBED/A0<2>.A1<2),  1ALB<2) 

COMMON  /CGEON/COSGM,COSBT, COSIN 
COMMON  /CONST/PI ,P12,PIRflD,TUOPI,TORRMB,COEGK 
calculate  albedo  for  ground  <ITARG»=1>  or  target  (ITARG^a) 
IALB<n  =  0  LAMBERTIAN  REFLECTION  SURFACE 
1  ISOTROPIC 
A=A0< I >+A1< 1 >*COSBT 
IF  <  I  ALB<  I  > .  EQ  .  0  >  ALBEDO*AfCOSGM/’PI 
IF  < IALB< I  ).EQ, 1  >  ALBEDO*A/TWOFI 
RETURN 
END 


ALB0004  0 
ALB00020 
ALB00030 
ALB00040 
ALB00050 
ALBOOOSO 
ALB00070 
AL600080 
ALBOGuSO 
ALBOGl 00 
ALB001 1 0 
ALB00120 


361 


oooooo 


m 


FUMCTION  BLACKS U,T> 

BLftCK<U,T>  =  PLANCK  FUNCTION  < UNITS;  WATT  PER  SQUARE  METER  PER 
MICROMETER  PER  STERADIAN),  GIVEN  WAVELENGTH  U  IN  CM  AND  TEMP¬ 
ERATURE  T  IN  K 

EXP  OVERFLOW  PROTECTION 


ARG=1 .4387B/'<Ut.T> 

IF< ARG . LT . 88 . >  GO  TO  1 

BLACK=0 . 0 

RETURN 

1  BLACK=1  .191  06E-1.iX<W**5*<EXP<  ARu>-1  .  U)> 
RETURN 
END 


BLAOuOl 0 
BLAOOOZO 
BLA00030 
BLA00040 
Blau  0050 
BLA00060 
BLA00070 
BLA00080 
BLA00090 
BLA001 00 
BLA001 1 0 
BLA00120 
BLA00130 
BLA00140 
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SUBkOUTINE  C0EFS<  P, T , vis, IHhZE, ZTrtRG^NCLD, lERR, BtTAEx  ) 

COMMON  ^'BKDAT/ALT  ,  THETA ,  PHI  ,  SAHG2 ,  ZENTH ,  PHASE  ,  ALB 
COMMON  /CTARG/RTARG , COSX , COSY , C0S2 
COMMON  /MO  1 /DUMMI E<  715), MHOLD , NL , 

RRS<  16,34), SCOE<  16,34), 

+  TR ANS<  1 6 , 5  )  , RADA< 1 6 , 2  ) , UAVE<  1 6  ) , SS< 1 6  ) , 

1  DIR<  16),RADG<  16),LITEM<  16>,UTRF<  16),BK<  16), 

2  PATHRC 16  ),UERP<  1 6  ) , PATHR2< 1 6 ) , TOT< 12  ),BKG< 16  ) 

COMMON  /BASPOT/  ANG< 65  ) , SUM< 65 ) , WVL< 1 6 ) , NWVL , ALBB(  1 6  ) , BS< 1 6  )  , 

1  BE< 16),SINGWV,PF<65) 

COMMON  /COMI 1/ISORC, ITARG, IWN, JHL 
COMMON  /CONST/  PI , PI2, PIRAD, TWOPI , TORRMB, CDEGK 
DIMENSION  P<34),T<34) 

C  CALCULATE  THE  WAVELENGTH-DEPENDENT  CONSTANT  PRESSURE  COEFFICIENTS 

C  FOR  MOLECULAR  SCATTERING. 

C  LOOP  OVER  LAYERS 
DO  6  0  0  I  =  1 , HL 
PS=P< I  )/l 013, 0 
T3=CDEGI</T(  I  ) 

C  LOOP^'OVER^UAVELENGTHS 
DO  600  IW=1 , IWN 
RAYS=0 . 0 

NW=1 0000 ./UAVE< lU) 

C  RAYLEIGH  SCATTERING  =  O.FOR  WAVELENGTH  GT  3 .  ;j3  UM 
IF  <NW,LT.3000)  GO  TO  200 

WN=FLuATCHW)  ’ 

RAYS=RSCAT*<WH**4>/<9.6757SE+13-1  .  1  1  83t.E  +  09>«UlN**2  > 

200  CONTI Nut 

AEXT*! . 

AABS=1 . 

IF  < IHA2E.EQ, O.OR. I .NE,<NCLD-1 )>  GO  TO  1 
EXT53=3 .912/VIS 

C  UPPER  LIMIT  OF  500  METERS  VERTICAL  DISTANCE  FOR  XSCALE 

2TALT=ZTARG/ALT 

IF  <ABS<ZTALT-1 ,  ),LT. . 01 >  RNG»RTARG 

I F  <  <  ZTARG . GT . ALT  ) . AND . <  RTARG , GT . . 5/C0S<  THETA^P IRAD ) ) > 

1  RNG-,5/C0S<THETA*PIRAD) 

IF  <  ZTARG,  LT.  RTARG,  AND.  <  RTARG.  GT.  .5/C0S<<  1  80  . -THETA  )t<PIRAD  )>  ) 

1  RNG=.5/C0S<<  180. -THETA  )*PIRAD;) 

IF  <  ITARG.Eu.0.AND.<RTARG,GT.  .  5/COS<  THETAi-PIRAD  )  )  ) 

1  RNG=.5/COS<THETA*PIRAD> 

ISLANT=1 

IF  <ABS<ZTALT-1 .  ).LT. . 01  )  ISLANT=0 
C  CALL  XSCALE  FOR  TOTAL  PATH  LENGTH  TRANSMISSION  FOR  AEROSOL 

CALL  XSCALE<WAVE< IW),88. , EXT55, XSTRN, lERR, ISLANT, IHAZE,RNG, THETA ) 

IF  < lERR .EQ. 1  )  RETURN 
AEXT=-ALOG< XSTRN )/RNG 

C  USER  SUPPLIED  COEFF< IHA2E=7  ),  OR  READ  FROM  PFN  DATA  FILE( IHA2E=8  )  CO 
IF  <IHA2E.EQ.7)  AEXT=BETAEX 
■  AEXT=BE<IW> 

is! .AND.«AVE< IW>.LE,5. 

8.  .AND,WAVE< IW>.LE. 12 


IF 

IF 

IF 

IF 


>  AABS=AEXTh<  .  2 
.  )  AAeS=AEXT>*' ,  45 


600 


<  IHAZE.Eu.8) 

<WAVE< IW>,LT 
WAVE< IW>.GE 
<WAVE< IW).GE 
CONTINUE 
3C0E< IW, I  )=AEXT-AABS+RAYS 
CHECK  FUR  NO  AEROSOL  PRESENT 
IF<SCOE< IW, I  ),LT. 1  .E-20)RRS< IW, I >=1 . 0 
AEROSOL  AND  RAYLEIGH  PRESENT 

IF<SCOE< IW, I ),GE. 1 .E-20)RRS< IW, I >»RAVS/SCOE< IW, I > 

CHECK  FOR  NO  RAYLEIGH  SCATTERING 

IF  <RAYS.LT.  1  .E-20)  RRSC  IW,  I  >>=0. 0 

CONTINUE 

RETURN 

END 


COEuOOi  0 
COE  0  0 02  0 
COE00030 
COE00040 
COE00050 
COE00060 
COE00070 
COE00080 
COE00090 
COEOOl 00 
COE001 1 0 
COE00120 
COE00130 
COEOOl 40 
COhOOiDU 
COEOO 1 60 
COEOOl  70 
COE001S0 
COEOOl 90 
COE  0  02 00 
COEOU21 0 
COE00220 
COE00230 
COE00240 
COE0025U 
COE00260 
COE 00270 
COE  00280 
COE0029O 
COE 003 00 
COE  0031  0 
COE 00320 
COE00330 
COE00340 
COE00350 
COE00360 
COE00370 
COE00380 
COE  00590 
COE  0  04 00 
COE0041 0 
COE00420 
COE00430 
COE  00440 
COE00450 
COE00460 
COE00470 
COE 00480 
COE 00490 
COE00500 
COE0051 u 
COE  0052  0 
CuE00530 
COE 00540 
COE00550 
COE00560 
COE00570 
COE00580 
COE00590 
COE 006 00 
COE0061 0 
C0E00620 
COE 00630 
COE00640 
CCE00650 


363 


o  o  r«  o  o  o  r  I  o  r«  r* 


SUbROUTINE  DIrtG 

THIS  SUBROUTINE  PRODUCES  DIAGNOSTIC  COMHENTARY  FOR  THE 
SPOT  PROGRAM. 

CALLING  SEQUENCE:  CALL  DIAG 

EXTERNAL.  VARIABLES  REQUIRED; 

THETA  < COMMON  BLOCK  BKDAT > 

HLIGHT^HTYPE  (COMMON  BLOCK  HOLRTH) 

LI  .L2,L3,L4,L5,L6  (COMMON  BLOCK  LOGIO 

LOGICAL  LI  ,L2,L3i.L4,L5,LS,L7 

COMMON  2BKDAT.-'ALT ,  THETA ,  PHI  ,  SAHG2 , 2ENTH ,  PHASE  ,  ALB 
COMMON  /HOLRTH,^  H I  TARG<  8 . 3  > ,  HI  SDRC(  6  >  5  > . 

1  HM0DEL(5,6),HLIGHT(3>,HMNLT<3>,HSNLT(3>, 

2  HTRGT(2),HTYPE(2>,HGRND<2) 

COMMON  /LOGICXL1 , L2 , L3 . L4 , L5 , L6 , L7 

COMMON  /lOUHIT/IOIN, lOOUT, I PHFUN , LOUHl T , NDIRTU^ HCLIMT , KSTOR 
DATA  171./' 

;  WRITE  HEADING, 

WRITE  (lOOUT^SOiO 

IF  ERRORS,  GO  TO  5;  OTHERWISE  PRINT  CLEAN  RUN  MESSAGE. 

IF  (LI  .OR.L2.0R.L3.0R.L4.0R.L5.0R.L6.0R.L7)  GO  TO  100 
WR I TE  (I OOuT ,  1  0  0  0  > 

GO  TO  700 

;  HERE  IF  THERE  WERE  ERRORS 

100  WRITE  (iOuUT,1100j 

IF  ( .NOT. LI >  GO  TO  200 
WRITE  ( 1 OOUT, 1 200 >  I 
1  =  1  +  1 

200  IF  (.N0T.L2>  GO  TO  300 

WRITE  <IOOUT,1300>  I,HLIGHT 
1  =  1  +  1 

300  IF  (.N0T.L3>  GO  TO  400 

WRITE  (IOOUT,1400)  I,HLIGHT 
1  =  1  +  1 

40  0  IF  (,N0T,L4.>  GO  TO  500 

WRITE  <IOOUT,1SC<0)  I,HTYPE 
1  =  1  +  1 

500  IF  <  .H0T.L5;>  GO  TO  600 

WRITE  (100UT,1600>  I,HLIGHT 
1  =  1  +  1 

600  IF  (.NOT.Lb)  GO  TO  700 

WRITE  (  lOOLlT,  1700.>  I, THETA 
1  =  1  +  1 

700  IF  <.N0T.L7>  GO  TO  800 

WRITE  <IOOUT,1800)  I, THETA 
:  WRITE  FOOTING, 

800  WRITE  ( lOOUT, 1900) 

900  FORMAT  < 1  HO , 2 1 X, 90( 1 H* ), 3< 7 , 21 X, 1 H# , 88X, 1H* > > 

1000  FORMAT  ( 2 1 X , 1 H* , 28X , 28HN0  SPOT  DIAGNOSTICS  FOR  THIS 

1  3HRUN,28X, 1H+,7,21X, 1H*,28X,8H -  ,ll(1H-> 

2  ,  13H - - - ,28X,  1H*> 

1100  FORMAT  (21X, 1H*,23X,25HSP0T  DIAGNOSTIC  MESSAGES 


t 

2 

3 


7HF0LL0W: ,28X, 1H+,7,21X, 1H*,28X,5H -  , 1 0( 1H- 

),  1X,8(  1H-),  1X,6(  1H->,29X,  1H’*,2(7,21X,  1H*,88X, 
IN*'  ) 


1200  FORMAT  ( 21 X, 1 Hf , 9X, 1 1 , 30H .  NUMBER  OF  WAVELENGTHS  <IWN) 


1 

2 

3 


9H  EXCEEDS  , 31 HALLOWABLE  DIMENSIONS;  IWH  RESET 
,8X, 1H*,7,2IX, IHf, 13X,6HT0  16, ,69X, 1H*,7,21X, 
1H*,88X, IN*) 


1300  FORMAT  ( 2 1 X, 1 H*, 9X, 1 1 , 1 2H ,  NO  DIRECT, 3A4, 9HINC1DEHT 


7HWITHIN  ,23HRECE TVER'S  FIELD  OF  VIEW . , 1 3X, 1H* 
,7,21X, 1H*,88X, 1H*> 


1400  FORMAT  ( 2 1 X , 1 H* , 9X , 1 1 , 25H .  ANGLE  OF  INCIDENCE  FOR, 


3A4,8HGREATER  ,21HTHAN  80.0  DECREES;  N0,12X, 
tH«,7,2tX,  tH4>,  13X,26HCALCULATIONS  WILL  BE  MADE 
14HF0R  ITARC  *  0  .  ,  35X,  1 M*,  7,  2 1 X,  1  88X,  1  H-*  > 


^  I  ^rrr  *  *  rtrw  “  v  >  /  ir 

1500  FORMAT  < 2 1 X , 1 H* , 9X, 1 1 , 1 H , , 1 X, 2A4 , 1 4H00ES  HOT  FACE 


DIAG0G1 0 
OIAGO020 
DIAG0U30 
DIAG 0040 
DI AG0050 
DI AG0060 
OIAG007U 
DI AGOOSO 
DIAG009U 
DIAG01 00 
DIAG01 1 0 
DIAG0120 
DIAG01 30 
DI AG0 140 
DIAC0150 
DIAG0160 
DIAG0170 
,NPLOTUDIAG0180 
DIAG0190 
D I AG  02  0  0 
DIAG021 0 
DIAG0220 
DIAG0230 
DIAG 0240 
DIAG02S0 
DIAG 0260 
DIAG 0270 
D1AG0280 
D1AG02SO 
DIAC0300 
DIAG 031 0 
DIAG  0.320 
DIAG0330 
DIAG0340 
DIAGC350 
DIAG0360 
DIAG0370 
DIAG 0380 
DIAG0390 
DIAG0400 
DIAG041 0 
D1AG0420 
D1AG043G 
DIAG0440 
DIAG0450 
DIAG0460 
DIAG 0470 
DIAG0480 
DIAG 0490 
DIAG0500 
D1AG051 0 
DIAG0520 
DIAG 0530 
DIAG 0540 
DIAG0550 
DIAG0560 
D1AG0570 
DIAG 0560 
DIAG0590 
D1AG0600 
DIAG 061 0 
D1AG0620 
OIAG0630 
DIAG 0640 
DIAG0650 
D1AG0660 
DIAG0670 
D1AC0680 
D1AG0690 
DIAG0700 
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T  yHRtL,EI  Vtft  , ,  45><,  i  H* ,  /  ,  i  H>*,b8K/  i  H*  > 

1600  FORMAT  <21X,  1Hh.,9X,  11  .  1H.  .3A4.22HILLUt1INATES  BACK  SIDE 
1  3H0F  ,7HTARGET,  ,33;<,  tH*,/,21X,  IHf^SSX,  IHf  ) 

1700  FORMAT  <  2 1  X ,  1  Hti ,  9X ,  1 1 , 30H  .  THETA  LESS  THAN  90  DEGREES 

1  tOHAND  ITARG  1 3H  =  1;  THETA  =, F6 , 4, 1 9X. 1 H* , ^ 

2  ,21X,  1H*,88X.  lH-»  > 

1800  FORMAT  < 21 X, IH*, 9X, 1 1 , 25H .  THETA  GREATER  THAN  90 

1  13HDEGREES  AND  19HITARG  =  0;  THETA  =  ,F7,4, 

2  13X, 1H».X,21X, 1H*,88X, IH*) 

1900  FORMAT  < 2< 2 1 X , 1 H% . 88X , 1 H* , / 2 1 X , 90< 1 H*  )  > 

RETURN 

tND 


DIAG071 0 
DIAG0720 
D1AG0730 
DIAG0740 
DIAG07S0 
DIAG0760 
DIAG0770 
DIAG0780 
D1AG0790 
D1AG0800 
DIAG081 0 
D1AGO820 


36S 


ononoooooo 


1 


SUBROUTINE  INDAT< lEMISS, IHRZE, IM,LEN,ML, 


COMMON 

COMMON 


1 


COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 


600 


1  t 


610 


MODEL, TBOUND, ISW. CLDHGT,BETAEX > 

/'RLBED.'ftOI  2  >,  AK  2  >,  lALBt  2  > 

/M01,^DUMMIE<715>,MHOLD,NLHOLD,DUMMYS<  1  088>, 

TRANSC 16,5>,RADA( 16,2),UAVE< 16>,SS< 16>, 
D1R< 16),RADG< 16),UTEM< 1 6  ) , UTRF< 1 6 > , BK< 1 6 > , 
PATHR<  16>,UERF':  16),PATHR2<  1  6  > ,  TOT<  12  )  ,  BKG<  16  ) 
/BKDAT/ALT, THETA, PHI , SAHG2 , 2ENTH, PHASE, ALB 
/COMII/ISORC, ITARG,  HJM, JHL 
,-'CONST/'PI  ,PI2,PIRAD,TW0PI ,  TORRMB,CDEGK 
/CTARG/RTARG , COSX , COSY , C0S2 
/EM:SS/EM<2),TM<2) 


IHOOOOl 0 
IND00020 
IN000030 
IND00040 
1ND00050 
IND00060 
IND00070 
IND00080 
IND00090 
IHD001 00 
1ND001 1 0 
IND00120 
,HPLOTUIND00130 


COMMON  /'GEOMET,^PTS<  f  5>,  IGEOSU 

IND00140 

COMMON  /BASPOTX  ANG< 65 >, SUM< 65 >, UVL( 1 6 >, NWVL , ALBB< 16),BS< 16>, 

IND00150 

BEC  161,SINGWV,PF<65>,LMAX 

IND00160 

DIMENSION  DAT<7>,TYPE<7) 

IND00t7O 

DATA  TYPE  /4HENVR , 4HEM I S , 4HATM  , 4HTARG , 4HREFL , 

4HSEKS,4HG0  / 

IND00180 

DATA  I2ER0  /’O/ 

IND00190 

IND0020U 

SUBROUTINE  INDAT  13  CALLED  UPON  TO  A>  READ  INPUT  CONTROL 

INDU021 0 

PARAMETERS,  WITH  CARD  ORDER  INDEPENDENT  INPUT 

<SEE  SPOT 

IND 00220 

FOR  MORE  DETAILS  AND,  B>  TO  READ  VALUES  OF  THE 

PHASE 

IND 00230 

FUNCTION  AT  SPECIFIED  ID  AND  WAVELENGTH. 

IND00240 

NOTE.  IF  ISORC  LT  2  OR  ITARG  LT  1  EM<t>,TM<l> 

,  EMt  2  >,  TM<  2  > 

IND 00250 

ARE  NOT  NEEDED. 

1ND00260 

IF  ITARG  LT  1  A0< > , A 1 (  >, I ALB< >  ARE  NOT 

NEEDED. 

IND 00270 
IND 00280 

ISW=i  ON  SECOND  CALL  TO  INDAT 

IND00290 

IF  < ISU.EQ . 1 >  GO  TO  400 

IND00300 

IF  < IZERO.GT. 0>  GO  TO  9 

INDOOSi 0 

ISORC=Ci 

IND 00320 

ITAftG=0 

IND00330 

MuDEL=0 

IND 00340 

IHAZE=u 

IND00350 

NLAM=0 

IND 00360 

EM< 1 )=0. 

IND00370 

TM< 1  )=0, 

IND 00380 

EM<:2>*0. 

IND00390 

TM<2)=0. 

IND00400 

ZEHTH-0. 

IND0041 0 

CLDHGT="0. 

IND00420 

PHASE=0. 

IND00430 

RTARG=0. 

IND 00440 

C0SK=0, 

IND 00430 

COSY=0- 

IND 00460 

COSZ=0 , 

IND00470 

A  0<  1  >=  0 . 

IND00480 

A1< 1 >=0 . 

IND00490 

IALB< I >=0 

IND00500 

A0<  2  ;=0 . 

IND0051 0 

Al<2>=0, 

IND00520 

IALB<2>=0 

IHD00530 

ALT=0, 

IND00540 

THETA=0. 

IND00550 

PHI=0. 

IND00560 

SAHG2“0 . 

IND00570 

IZERO»l 

IND00580 

CONTINUE 

IND00590 

WRITE< IOOUT,6CO) 

IND00600 

FORMAT< 1H0,  'SPOT  CONTROL  CARDS  READ  FOR  THIS  RUN:'/> 

IND006f  0 

DO  to  1=1,7 

tND00620 

READ  <IOIN,11)  <DAT< J), J=1 ,7) 

IND00630 

FORMAT  < A4,6X,7EJ 0,4> 

IND00640 

URITE<  I00UT,61  0)<DAT<  J>,  J-1 ,7) 

1ND00650 

FORMAT<1H  ,A4,6X,7E1 0,4) 

IND00660 

IF  <DAT( 1  ).EQ,TVPE< 1 ))  CO  TO  1 

1ND00670 

IF  <DAT< i  ).EQ.TYPE<2))  CO  TO  2 

IND00680 

IF  <DAT(  1  >.ECI.TYPE<3>)  GO  TO  3 

IND00690 

IF  <DAT< 1 >.EQ.TYPE<4  ))  GO  TO  4 

IND00700 
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IF  <  DhT<  1  >  .  EQ  .  TyPE<.' 5  j  >  GO  TO  5 
IF  <DAT<  1  >.EQ.TypE<6  :>•;  GO  TO  6 
IF  <  DhTc' I  .  EQ  .  TYPE<  7  >  >  GO  TO  7 
C  ERROR  RETURN 

UkITE  < lOOUT, 1 01  ) 

101  FORMAT<1H  , 48HIHC0RRECT  INPUT  CARD  FOR  SPOT,  CONTROL  RETURNED  , 
1  18HT0  MAIN  FROM  INDATJ 
IHA2E=8 
RETURN 

C  OPERATING  ENVIRONMENT 

1  ISORC=IFIJ<(  DAT<  2  >  ) 

itarg=ifix(:dat<3:>> 

IHA2E=IFIX<  DAT<  4  )  ; 

M0DEL=IF1X<DAT<5:>> 

NLAM  =  iFlX<  DAT<  6  ')  ) 
ic>=ifix<;dat<7)> 

GO  TO  S 

EMISSIVITY  AND  TEMPERATURE  OF  GROUND  AND  TARGET,  RESPECTIVELY 
EMC  1  )=DAT<  2) 

TM<  1  >=DATC3> 

EMC  2  >=DATC  4  ) 

TMC2)=DAT<5) 

TbOuND=TMc 1  ) 

GO  TO  8 

INCIDENT  ZENITH  ANGLE  OF  RADIATION,  CLOUD  BOTTOM  HEIGHT, 

PHASE  ANGLE  OF  MOON,  OPTIONAL  EXTN  COEF  CVALID  WHEN  IHAZE=8> 
2ENTH=DAT<  2  ) 

CLDHGT»DAT<3) 

PHASE=DAT<  4  > 

BETAEX=DAT<5) 

GO  TO  8 

TARGET  PROPERTIES 
RTARG=DATC  2  ) 

C0SX=DAT<3) 

C0Sy=DAT<4 ) 

C0SZ=DAT<5  ) 

GO  TO  8 

ALBEDO  COEFFICIENTS  AND  TYPE  OF  REFLECTION  SURFACE  FOR 
GROUND  AND  TARGET,  RESPECTIVELY 
A0<  1  )=DAT<2) 

A1 < 1  >=DAT<  3 ) 
lALBC 1 )-IFIX<DAT<4 >> 

A0<2>=DAT<5) 

A1<2)=DAT<6) 

IALB<2)-IFIX<DAT<7>> 

GO  TO  8 

SENSOR  CHARACTERISTICS 
ALT=DAT<2) 

THETA=DATC3) 

PHI=DAT<4> 

EXPECTING  INPUT  AZIMUTH  IN  METEOROLOGICAL  CONVENTION 
cl.E.,  N  -  0  DEG,  E  «  90  OEG,  S  »  190  DEG,  U  >  270  DEG>, 

SO  CONVERT  TO  MATHEMATICAL  CONVENTION  FOR  PURPOSES  OF 
SPOT  CASSUMING  Y-AXIS  IS  POSITIVE  NORTHWARD,  X-AXIS  POSI¬ 
TIVE  eastward:). 


PHI=90.-PHI 
SANG2=DAT<  5 ) 

8  CONTINUE 

10  CONTINUE 

7  CONTINUE 

IEMISS=0 
IM=0 
LEN«0 
ML  =  0 

IF  CISORC.GT.I)  IEM1SS=1 
COSX=COS<  COSX*P IRAO ) 
COSY=COS<COSY*PIRAD) 
COSZ=COS<  COSZ>»PIRAD  > 


INDOuZI 0 
I ND 00720 
IND00730 
I ND 00740 
IND00750 
IND00760 
I ND 00770 
I ND 00780 
INDOO.'SO 
I ND 008 00 
IND00S1 0 
I ND 00820 
IND0063U 
IHD00S40 
I ND 00850 
IND00S60 
INDOOScO 
IND0088G 
IND00890 
I ND 009 00 
INDU091 0 
IND00920 
I ND 00930 
IND00940 
IND00950 
IND00960 
IND00970 
I ND 00980 
IND00990 
IND01 000 
INDul 01 0 
I ND 01 020 
iNDOl 030 
IND01 040 
INDOl 050 
INDOl 060 
IND01070 
INDOl 080 
INDOl 090 
INDOl 1 00 
INDOl 1 1 0 
INDOl 120 
INDOl 130 
INDOl 140 
INDOl 1 50 
INDOl 160 
INDOl 170 
INDOl 180 
INDOl 190 
IND01200 
IND0121 0 
IND01220 
IND01230 
IND01240 
IND01250 
IND01260 
IND01270 
IND01280 
INDOl 290 
INDOl 300 
INDOl 31 0 
1NDC1320 
IND01330 
IND01340 
IND01350 
IND01360 
IND01370 
IND01380 
1ND01390 
IND0140G 


I 
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C  GEOMETRICAL  OPTION 

IF< IGEOSU. NE . 1  )GO  TO  311 

RTAftG=SQRT<  <  PTS<  4  )-PTS<  1  >  PTS<  5  >-PTS<  2  >  >**2  + 

+  (PT3<6)-PTS<3)  >*♦2  ) 

THETA=ACOS<  <  PTS<  3  >-PTS<  6  > )/RTARG  > 

RTDC.ON=1  .  0,-’PIRAD 

THETh=THETA*RTC'CON 

hLT=PTS<6> 

DELX=PTS< 1  >~PTS<4> 

DELY=PTS<2>-PTS<5> 

H0I3=3QRT<DELX=*>«2+DELY‘f=f2> 

PHI=AC03<DELX/HDIS  > 

PH  I  =  PH  I  h*RTDCON 
IFcOELY.lt.  0. 0>PHIo36Ci.  0-PHI 
311  CONTINUE 

IF  <ITARG.EQ.1>  RTARG=ALT/>ABSC  COSC  THETA*P  IRAD  >  > 

IF  < ITARG .EQ. 0  )  RTARG=1  000.0 
RETURN 

400  CONTINUE 

REUINO  IPHFUN 
00  t^OO  I=>1  ,  lUN 
500  PFCI)=0. 

IF  CNLAM.Nfc.O)  CALL  PFUNCclD) 

RETURN 

tND 


INDOMt  0 
IND01420 
IHuOl 430 
I ND 01 440 
IND01450 
I  NO  01 46  0 
InDOI 470 
IND01 4S0 
INO 01430 
INDOI 500 
IND0i5i 0 
I ND 01 520 
IND01530 
INDOI 540 
IND015i0 
IND01 560 
INDOI 570 
INDOI 5S0 
INDOI 530 
INDOI 600 
INDOI 6 1 0 
IND01620 
INDOI 650 
INDOI 640 
INDOI 6dO 


SUBROUTINE  OUTPUTS  MODEL  ,  IHfl2E,  CLDHGT  > 

LOGICAL  LMNLT 

COMMON  /MOW  0UMMIE<715>,MH0LD,NLH0LD,DUMMyS';  1  088), 

►  TRANS<  16,5  ),RADAf 16,2),«AVE<  16  >,SS< 16  ), 

I  DIR<  16),RADG<  16),UTEM<  16),UTRF<  16),BK<  16), 

I  PATHR< 16  ),UERF< 1 6  ) , PATHR2< 1 6 ) , TOT< 12  >,BKG< 16  > 

COMMON  /BKDAT/ALT, THETA, PHI , SANC2 , 2ENTH , PHASE , ALB 
COMMON  /COMI  l/'ISORC,  ITARG,  lUN,  JHL 
COMMON  /ANSW2/TTR< 16),TBR< 1 6 > , CNTRST< 1 6 > 


COMMON  /ANSW2/TTR< 16),TBR< 1 6 > , CNTRST< 1 6 > 

COMMON  /HOLRTH/  HI TARG< 8 . 3 > , HI SORC< 6 , 5 > , 

1  HMODELC  5 , 6  ) , HL I GHT<  3 ) , HMNLT<  3 ) , HSHLTC  3 ) , 

2  HTRGT<2),HTVPE<2),HGRND<2> 

COMMON  /lOUNIT/IOIH, lOOUT, I PHFUN, LOUNIT, NDIRTU , NCL I MT , KSTOR , 
DATA  HGRND,-'4H  GR0,4HUHD  / 

DATA  HIS0RC/'4HSUNL,4H1GHT,  4H  0NL,4HY  ,  4H  ,  4H 

1  4HM00N,4HLIGH,4HT  0N,4HLY  , 4H  i4H  ,4HEMIS, 

2  4HSI0N,4H  0NL,4HY  , 4H  , 4H  , 4HSUNL , 4H I GHT , 

3  4H  AND,4H  EMI , 4HSSI0, 4HN  , 4HM00H , 4HL I GH , 4HT  AN, 

4  4HD  EM,4HIS3I,4H0N  7 

DATA  HITARG/'4HN0  R ,  4HEFLE ,  4HCTAN, 4HCE  ,  4H  ,  4H 

1  4H  ,4H  ,4HGR0U,4HND  R , 4HEFLE , 4HCTAN , 4HCE  /, 

2  4H  EMI , 4HSSI0,4HN  ,4HTARG,4HET  R, 4HEFLE , 4HCTAN , 

3  4HCE  7,4H  EMI ,4HSSI0,4HN  / 

DATA  HM0DEL.''4HTR0P,4HICAL,4H  ,  4H  ,4H  ,4HMIDA, 

1  4HLTIT,4HUDE  ,  4H3LIMM ,  4HER  ,  4HM1DA,  4HLTIT  .  4HUDE  , 

2  4HUINT,4HER  , 4HSUBA , 4HRCT I , 4HC  SU,4HMMER,4H 

3  4HSUBA,4HRCTI,4HC  «I,4HNTER,4H  ,4Ht962,4H  U.S, 

4  4H,  ST,4HANDA,4HRD  / 

DATA  HMNLT/4H  MO , 4HONLI , 4HGHT  / 

DATA  HSNLT74H  SU , 4HHLIG , 4HHT  / 

DATA  HTRGT/'4H  TAR,4HGET  / 

DATA  HTYPE/'4H  ,  4H  / 

DATA  LMNLT7. FALSE./ 

IF  < ISORC.NE. O.AND. 1S0RC.NE.3>  GO  TO  200 
DO  100  1=1,3 
100  HLIGHT< I  )=HSNLT< I ) 

GO  TO  400 
200  DO  300  1=1,3 
300  HLIGHT< I  )=HMNLT< I ) 

LMNLT=.TRUE. 

400  IF  < ITARG, EQ.O)  GO  TO  600 
IF  <  ITARG.EGl.2>  GO  TO  500 
HTYPE< 1  )=HGRND< 1  ) 

HTYPE<2)=HGRND<2) 

GO  TO  600 

500  HTYPE< 1  )=HTRGT<  1  ) 

HTYPE<2)=HTRGT<2) 

600  CALL  DIAG 

IF  <M0DEL.GT.7)  GO  TO  700 

WRITE  <IOOUT,  1400)  I SORC , < HISORC< I , ISORC+ 1 >, I  *  1 , 6 > , 


WRITE  <IOOUT,  1400)  I SORC , < HISORC< I , ISORC+ 1 >, I  *  1 , 6 > , 

1  ITARG, < HI TARG< I, ITARG+1 ), 1*1 , 8 >, MODEL , 

2  <HMODEL< I,MODEL), 1*1 ,5), IHA2E 
GO  TO  750 

700  IF<M0DEL.EQ.8)WR1TE  < lOOUT, 1 450 )  ISORC, < HI 30RC< I , ISORC+ 1  > , I  * 
1  ITARG, <HITARG< I, ITARG+1  ), 1  =  1 , 8 ), MODEL, IHA2E 

IF<M0DEL,EQ.9)WRITE  <IOOUT,1500)  ISORC,<HISORC( I , ISORC+1 >, 1= 
1  irARG,<HITARG< I, ITARG+1 ), 1=1 ,8>, MODEL, IHA2E 

750  IF  <IHA2E.GT.0)  WRITE  <IOOUT,1600)  CLDHGT 
800  WRITE  < lOOUT, 1700) 

IF  <LMNLT)  WRITE  <IOOUT,1800>  PHASE 
WRITE  <IOOUT,1900)  HLIGHT 
DO  900  1=1 , IWN 
NW=1  0000 ./WAVEC I  ) 

900  WRITE  <IOOUT,2000)  WAVE< I ), NW, SS< I >, BK< I >, 8KG< I  ) 

WRITE  < I00UT,21 00) 

DO  1000  1*1, IWN 
NW=1 OOOO./WAVEC I > 

1000  WRITE  <IOOUT,2200>  WAVE< I >,NW,UTEM< I >.UTRF< I >, 

1  RADA< I,2),PATHR2< I >,TTR< I  ) 

WRITE  < IOOUT,2300) 


OUTP001  0 
OUTP0020 
OUTP0030 
OUTP004n 
OUTP0050 
OUTP0060 
OUTP0070 
OUTP0080 
OUTP0090 
OUTP01 00 
OUTP01 1 0 
OUTP0120 
NPLOTUOUTP0130 
OUTP01 40 
OUTP0150 
OUTP0160 
OUTP0170 
OUTP0180 
OUTP0190 
OUTP0200 
OUTP02t  0 
OUTP0220 
OUTP0230 
OUTP0240 
OUTP0250 
OUTP0260 
OUTP0270 
OUTP0280 
OUTP0290 
OUTP0300 
OUTP031 0 
OUTP0320 
OUTP0330 
OUTP0340 
OUTP0350 
OUTP0360 
OUTP0370 
OUTP0380 
OUTP0390 
OUTP0400 
OUTP041 0 
OUTP0420 
OUTP0430 
OUTP0440 
OUTP0450 
OUTP0460 
OUTP0470 
OUTP0480 
OUTP0490 
OUTP0500 
OUTP051 0 
OUTP0520 
OUTP0530 
1,6),  0UTP0540 
OUTP0550 
1,6),  OUTP0560 
OUTP0570 
OUTP0580 
OUTP0590 
OUTP0600 
OUTP061 0 
OUTP0620 
0UTP0630 
OUTP0640 
OUTP0650 
OUTP0660 
OUTP0670 
OUTP0680 
OUTP0690 
OUTP0700 
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DO  1100  1=1 , lUN 
NU)=1  0000  ./UPVE<  I  ) 

1100  WRITE  <IOOUT.2200>  WPVE<  I  Nu) ,  RPDu<  I  >,  UERF<  I  >, 

1  RADftC 1 , 1  >,PATHR< 1 >,TBR< I  ) 

WRITE  <IOOUT,2400)  HEIGHT 
IF  <LMNLT)  WRITE  <IOOUT,1800>  PHASE 
WRITE  <IOOUT,2500>  HL I GHT , HL I GHT 
DO  1200  1=1 , IWN 
NW=1 0000 ./WAVE< I > 

1200  WRITE  <IOOUT,2600)  WAVE< I > > NW . SS< I > , DIR< I > 

WRITE  < IOOUT,2700) 

DO  1300  1=1, IWN 
NU  =  1  0000 ./WAVE< I  ) 

1300  WRITE  <IOOUT,2800)  WAVE< I  ), NW, TTR< I >, TBR< I >, CNTRST< I > 
WRITE  <IOOUT,2900)  (  TOT<  I  ) ,  I  =  1  ,  1  0  > ,  TOT<  1 2  ),  HU  GHT , 

1  TOT<  1 1  ) 


RETURN 


CONTROL 


1400  FORMAT  < 43X, 37HDEFINITI0N  OF  CONTROL  PARAMETERS 

1  8HF0LL0WS:  ,/',43X,  1  0<  1H->,6H  —  ,7<1H-),2X, 

2  1  0<  1H-),2X,7<  1H-),/’X/,43X,9HPARAMETER,3X, 

3  5HVALUE,3X, 1 1 HOESCRI PT ION , / , 43X, 9<  t H- >, 3X , 5< 

4  1H-),3X, 1 1< 1H- >, //,45X,5HIS0RC,7X, 1 1 ,5X,6A4,// 

5  , 45X, 5HITARG, 7X, I  1 , 5X , 8A4 , //, 45X, 5HM0DEL , 7X , 

6  II ,5X,5A4,XX,45X,5HIHA2E,7X, 1 1 , X > 

1450  FORMAT  < 43X, 37HDEFINITI0N  OF  CONTROL  PARAMETERS 

1  8HF0LL0WS: ,X.43X, 1 0< 1H->,6H  —  ,7(1H-),2X, 

2  1  0<  1H->,2X,7<  1H->,/'XX,43X,9HPARAMETER,3X, 

3  5HVALUE,3X, 1 1 HDESCRIPTION , 43X, 9< 1 H- >, 3X, 5( 

4  IH-  ),3X, 1 1< IH- ), XX,45X,5HIS0RC,7X, II ,5X,6A4,XX 

5  ,45X,5HITARG,7X, II , 5X , 8A4 , X/, 45X, 5HM0DEL , 7X , 

6  I1,5X,  32HISRAELI  STANDARD  <YEAR,  DAYTIME  .V/45X, 5HIHAZE, 7X, 1 1 X > 
1500  FORMAT  < 43X , 37HDEF INIT ION  OF  CONTROL  PARAMETERS 

1  8HF0LL0WS! ,X,43X, 1 0< 1H->,6H  —  ,7<1H->,2X, 

2  1 0< 1H-),2X,7< 1H-),XXX,43X,9HPARAMETER,3X, 

3  5HVALUE,3X, 1 1 HDESCRIPTION, X, 43X, 9< 1H->,3X,5< 

4  1H-),3X, 1 1< 1H-),XX,45X,5HIS0RC,7X,11 ,5X,6A4,XX 

5  , 45X,5HITARG, 7X, II , 5X , 8A4, XX , 45X,5HM0DEL , 7X, 

6  II ,5X,34HISRAELI  STANDARD  <YEAR,  NIGHTTIME  )XX45X , 5HIHA2E, 7X, 1 1 X > 
1600  FORMAT  <1H  , 45X, 22HCLOUD  BOTTOM  HEIGHT  =  ,F5.3,3H  KM) 

1700  FORMAT  < 1 H 1 , 56X , 1 9HS0URCE  INTENSI T lES, X, 56X, 7H - 

1  12H - ,XX) 

1800  FORMAT  < 44X , 27HPHASE  ANGLE  FOR  MOONLIGHT:  ,F6.2, 

1  lOH  < DEGREES), XX) 

1900  FORMAT  < 1 5X , 1 OHWAVELENGTH , 3X , 1 OHWAVENUMBER , 3X , 3A4 , 

1  6HS0URCE, 1 IX, 13HTARGET  SOURCE , 1 5X, 7HGR0UND 

2  6HS0URCE,X, 15X,9H<M1CR0NS),6X,6H<CM-1 ), 1 IX, 

3  SHSTRENGTH, t 7X , 8HSTRENGTH , 20X, 8HSTRENGTH , X 

4  ,41X,20H<WATTS  M-2  MICRON-1 ), 2< 3X, 9H< WATTS  M- 

5  16H2  MICRON-1  SR- 1  )  ) , X , 1 5X, 1 0< 1 H- ), 3X , 1 0< 1 H- ) , 

6  3X,20< 1H-),3X,25< 1 H- ) , 3X , 25< 1 H- ), XX ) 

2000  FORMAT  < 1 5X, 1  PEI  0 , 4, 3X, 17 , 1 1 X , 1  PE  1 0 . 4 , 1 5X, 1  PEI  0 , 4 , 1 8X, 

1  1PE10.4) 

21 00  FORMAT  < 1H1 ,46X,33HC0MP0NENTS  FOR  RADIANCE  FROM 

1  6HTARGET,X,46X,29H -  — 

2  lOH —  - ,XX,53X,23H<WATTS  M-2  MICRON-1  SR- 

3  2H1  ),XXX,22X, 1 OHWAVELENGTH, 3X, 1 OHWAVENUMBER, 

4  5X,<.HTARGET,  7X,6HTARGET,7X,7HPARTIAL,6X, 

5  7HPART I AL,6X,5HT0TAL,X,22X,9H< MICRONS >,6X, 

6  6H<CM-1  ),6X,8HEMISSI0N, 4X, 1 1 HREFLECTANCE , 2X , 

7  1 1HATM0SPHERIC,5X,4HPATH,8X,6HTARGET,X,75X, 

8  8HEM I SS I  ON , 5X , 8HRAD I ANCE , 5X , 8HRAD I ANCE , X 

9  ,22X,  1  0<  1H-),3X,  I  0<  1  H-  ) ,  4X , 8<  1 H- >,  4X,  1  U  IH-  ), 

X  2X,  1  1<  1H-),3X,8<  1H-),5X,8<  1H-),XX) 

2200  FORMAT  < 22X, 1  PEI  0 . 4, 3X, 17 , 3X, 1 PSEl 3 , 4 ) 

2300  FORMAT  < 1  HI , 47X , 29HC0MP0HENTS  FOR  BACKGROUND 

1  8HRADIANCE,X,47X,27H -  -  - 

2  lOH  - ,  XX,  53X,23H<  WATTS  M-2  MICRON-1  SR- 

3  2H1 >,XXX,22X, 1 OHWAVELENGTH, 3X, 1 OHWAVENUMBER, 

4  3X , 6HGR0UND , 7X , 6HGR0UHD , 8X , 5HT0TAL , 8X, 5HT0TAL , 


OUTP071 0 
OUTP0720 
OUTP0730 
OUTP0740 
OUTP0750 
OUTP0760 
OUTP0770 
OUTP0780 
OUTP0790 
OUTP0800 
OUTP081 0 
OUTP0820 
OUTP0330 
OUTP0840 
OUTP0350 
OUTP0860 
OUTPCI870 
OUTP0880 
OUTP0890 
OUTP0900 
OUTP091 0 
OUTP0920 
OUTP0930 
OUTP0940 
OUTP0950 
OUTP0960 
OUTP0970 
OUTP0980 
OUTP0990 
OUTPl 000 
OUTPl 01 0 
OUTPl 020 
OUTPl 030 
OUTPl 040 
OUTPl 050 
OUTPl 060 
OUTPl 070 
OUTPl 080 
OUTPl 090 
OUTPl 1 00 
OUTPl 1 1 0 
OUTPl 120 
OUTPl 130 
OUTPl 140 
OUTPl 150 
OUTPl 160 
OUTPl 170 
OUTPl 180 
OUTPl 190 
OUTP1200 
OUTP121 0 
OUTP1220 
OUTP1230 
OUTP1240 
OUTP1250 
OUTPl 260 
OUTP1270 
OUTP1280 
OUTP1290 
OUTP1300 
OUTPl 31 0 
OUTPl 320 
OUTPl 330 
OUTPl 340 
OUTP1350 
OUTPl 360 
OUTP1370 
OUTPl 380 
OUTP1390 
OUTP1400 
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ui^wpj  — xvficp^iij-cnjs^wrs)-*  ijscn^ujK'—  cjfo-*  —  Xviico-Ni^^cn 


7X, SHTOThL , 7, 22X, 9H<  MICRONS  >, 6X,6H<  CM-i  >, 6X , 
8HEMISSI0N, 4X, 1 1 HREFLECTANCE , 2X , 1 1 HATMOSPHER  I  C 
,  5X,  4HPATH,  6X,  I  OHBACKGPOLIND, /,  75X,  8HEMI3SI0N  , 
2<  5X,8HRADIANCE /,22X. 1 0< 1 H- ) , 3X , 1 0< 1 H-  ) , 4X . 
8<  1H-  ),4X,  1  1<  iH-  >,2X,  n<  1H-  >,3X,8<  1H-  4X,  1  O'; 

FORMAT  <  1H1 ,58X,6HDIRECT,3A4,X,57X,6< 1 H- 1 X,  1 2<  1 H- >, / 
X,56X,20H<WATTS  M-2  M I  CRON- f  > , /X > 

FORMAT  <41X>  «  OHWAVELENGTH , 3X , 1 OHUAVENUMBER , 2X , 3A4 , IX. 

3A4. 7. 4 1 X. 9H<  MICRONS  >. 6X, 6H<  CM-1  ) . 7X . 6HS0URCE . 
8X  .  4HFLLIX  .  / ,  68X,  8HSTRENGTH ,  7 . 4 1  X.  1  O':  1  H-  ) 3X . 
t  0<  1H-  >.  2X,  ?2<  IH-  >.  IX,  12<  tH-).77> 

FORMAT  <4IX, 1PE1 0 ,4,3X, I7,6X, 1PE1 0 .4,3X, 1PE1 0 . 4  ) 

FORMAT  < 1H1 ,58X, 15HT0TAL  RADI ANCE , 7, 58X , 1 1 H -  - 

4H - , 77, 33X, 25H< WATTS  M-2  MlCRON-1  SR-1),777 

,35X, 1 0HWAVELENGTH,3X, 1 OHWAVENUMBER , 5X , 
6HTARGET,5X, t  OHBACKGROUND , 4X , 8HC0NTRAST , 7 
, 35X, 9H<  MICRONS  ), 6X, 6H<  CM-1  ) , 33X , 5HRAT 1 0 , 7 
,35X,  1  0<  IN-  ),3X,  1  0<  1H-  ),5X,6<  1H->,5X,  1  0<  IN-  ), 
4X  SC  1  H”  / /  y 

FORMAT  <35X, 1  PE  1 6 ! 4 , 3X , 1 7 , 3X , 1P3E13,4> 

FORMAT  < 1H1 ,46X,30HDETECTOR-RESPOHSE  WAVELENGTH- 
1 0HINTEGRATED,7,46X, 1 7< 1 H- ) , 2X , 2 K 1 H- ) , 77 
,58X, 16H< WATTS  M-2  SR- 1 > , 77 , 46X , 7HTARGET 
8HEMISSI0N, 16X, 1  PE  1 0 . 4 , 7 , 46X , 7HTARGET 
t  1HREFLECTANCE,  t  3X,  1  PE  1  0 , 4 , 7 , 46X ,  8HPAPT I AL 
2  0HATMOSPHERIC  EMISSION, 3X, 1  PE  1 0 . 4, 7 , 4SX , 
2IHPARTIAL  PATH  RADI ANCE , 1  OX , I  PE  1 0 . 4 , 7, 4eX , 
21HT0TAL  TARGET  RAD  I ANCE , 1  OX , 1  PE  1 0 . 4 , 7 , 46X , 
15HGR0LIND  EMISSION,  16X,  1  PE  1  0 . 4 , 7,  46X ,  7HGR0UND 
t 1HREFLECTANCE, 1 3X, 1  PE  1 0 . 4 , 7 , 46X, 6HT0TAL 
20HATMOSPHERIC  EM  I SS I  ON , 5X, t PE  1 0 . 4, 7, 46X , 
19HT0TAL  PATH  RAD  I ANCE , 1 2X , t PE  1 0 . 4 , 7 , 4bX , 
25HT0TAL  BACKGROUND  RADI ANCE , 6X , 1  PE  1 0 . 4 , 77 
,46X,41<  1H>f  ),77,46X,8HC0NTRAST,22X,  1PE1  1  .4,77 
,46X,41< 1H*>,77,46X,6HDIRECT,3A4, 13X, 1  PEI  0.4,7 
,46X, 1 1H<WATTS  M-2)> 

END 


OUTPMt  0 
OUTP1420 
OUTPM30 
OUTP1440 
OUTP1 450 
OUTP1460 
OUTP1470 
OUTP1480 
OUTP1490 
OUTP1500 
0UTP151 0 
OUTPI520 
OUTP1530 
OUTP1540 
OL1TF155  0 
OUTP1 560 
0UTP1570 
OUTP1580 
OUTP1590 
OLITP1600 
0UTP161 0 
OUTPt620 
OUTP1 630 
OUTP1 640 
OUTP1650 
OUTP1660 
OLITPI  670 
OL'TP1680 
OUTPt690 
OUTP1700 
0UTP171 0 
OUTP1 720 
OUTP1730 
OUTP1 740 
OUTP1 750 
OIJTP1760 
OUTP1770 
OLITPI  780 
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SUBROUTINE  PATHRD< CTHED, HP. RT, 10. IHAZE.HR, 

1  lEMlSS.LEN.MODEL, VIS, VI , V2 , TGRD . OUMMV. ICLMAT , MULPV > 

LOGICAL  HORIZ 

DIMENSION  TR1<  )6>,TR2<  16>.DUMMY<  16>,ANS<  16> 

COMMON  /BASPOT/  ANGC  65  > , SUM<  65  > , UVL< 16). HMVL , ALBB< 1 6  > . BS< 1 6  > , 

1  BE< 16>,SINGWV,SAER<65>,L0UM 
COMMON  /BKDAT/ALT,  THETA.  PHI SANG2 ,  ZENTH, PHASE ,  ALB 
COMMON  /CGEOM/COSOM . COSBT . CSA 
COMMON  /COM11/1SORC, ITARG, lUN, OHL 

COMMON  /MO  I /EH< 1 6 , 34  > . P<  34  > , T<  34  > . WH<  34  > . 2<  34  ) . WA<  34  > . RE , M , NL , 
+  RRSO6.34).SC0E<  16.34>, 

+  TRANS<  I6.5>.RA0A<  I6.2>,UAVE<  I6>.SS<  16>. 

1  OIR<  16>.RADG<  16),UTEM<  16).UTRF<  16>,BK<  16  >, 

2  PATHR<  16>.UERF<  16>.PATHR2<  16),T0T<  12>,BKG<  16> 

>*.*♦*  C0NST1  =  <  1  0295>*.5*3./<8.*PI  )/<  t  .♦.5*.  0295> 


,/<8,*PI > 
0034701 189/ 


C  C0HST2  =  .  0295<-'<  1  .  +  .  5* .  0295  >*3  . 

DATA  CONST  1 .C0NST2/ . 0570805145. 

NLL=NL-1 

3RAYL=C0NST1  >*<  1  . +CSA*CSA  )+C0HST2 
C  ****  INITIALISE  VARIABLES  >!■>••■•■>» 

DO  800  iw=1 . IwN 
PATHR<  Ui)=0, 0 
DO  900  J=2,NLL 
IF  <HP.LT.2<J))  GO  TO  1000 
900  CONTINUE 
J*NLL 
JU=J 
JL=JU-1 
H0RI2= .FALSE. 

DS1=0. 0 
H2=HP 

RAT=<  H2-Z<  JL ) Z<  JU  >-Z<  JL ) ) 

GO  TO  <1100. 1200. 1300). 10 
IXsRTfl .99999+1 
Ok'=ftT/FLOAT<  IX  ) 

DH=DX>*CTHED 

HORIZ=ABS<  CTHED  > . LT . 1 . E-3 
OISTaO.S+DX 
GO  TO  1400 
1X=NLL-JL 
DH=2<  JU )-HP 
DX=DH/CTHEO 
GO  TO  1400 

HORIZONTAL  PATH  FOLLOWS 
IX“1 00 

DI3T=DIST-0.5*DX+0.25 
DX=0.5 
HORIZ*. TRUE. 

GO  TO  1500 
H2=HP+0H*0.5 
DO  2600  K=1.IX 
IF  <HORIZ>  CO  TO  2000 

CALL  LT4M<HP, H2. THETA, 2. 2. TR1 .DUMMY. DUMMY, 

1  lEMlSS.LEN.MODEL, VIS.  VI , VZ.TGRO, ICLMAT, lERR, 

2  NR. IHAZE.MULDV) 

CALL  LT4M<H2,0UM. ZENTH. 3. 2, TR2. DUMMY, DUMMY. 

1  lEMlSS.LEN.MODEL, VIS,  VI ,V2, TGRD, ICLMAT, lERR, 

2  NR. IHAZE.MULDV) 

...  __  - - 


800 


1  000 


1  1  00 


1200 


1300 


1400 

1500 


.2)  GO 
»2,NLL 
,2<  J)> 


TO 


IF  < 10. EQ. 

DO  1600  J= _ 

IF  <H2.LT.2<J)>  GO  TO  1700 
1600  CONTINUE 
J*NLL 
1700  JU=J 

JL-JU-1 

RAT=<  H2-2<  JL  >  >/<  2<  JU  >-Z<  JL  )  ) 

1800  DO  1900  1U*1 , lUN 

SC-SCOE< IW, JL)+RAT*<  SCOE< I«. JU>-SCOE< IW,  JL)> 
RS=«RRS<  IW,  JL  >+RAT**-<  RRS<  IW,  JU  )-RR8<  IW,  JL  )  ) 
SSCAT»RSH.SRAYL  +  <  1  .  0-RS  >'*SAER<  IW  ) 


PADOOOl 0 
PAD0002C 
PAD00030 
PA000040 
PAD00050 
PAD00060 
PAD00070 
PAD00080 
PAD00090 
PAD001 00 
PAD001 1 0 
PAD00120 
PAD00I30 
PAD00140 
PAD00150 
PAD00160 
PADOOl 70 
PAD00180 
PADOOl 90 
PAD 002 00 
PAD0021 0 
PAD00220 
PAD00230 
PAD00240 
PAD00250 
PAD00260 
PAD00270 
PAD002d0 
PAD 002 90 
PAD00300 
PAD 0051 0 
PAD00320 
PAD 00330 
PAD00340 
PAD00350 
PAD00360 
PAD00370 
PAD00360 
PAD00390 
PAD00400 
PAD0041 0 
PAD00420 
PAD00430 
PAD 00440 
PAD00450 
PADOt,  *60 

PAD0ii4  f  0 

PAD 004 80 
PAD00490 
PAD00500 
PAD 0051 0 
PAD00520 
PAD 00530 
PAD00540 
PAD00550 
PAD00560 
PAD00570 
PAD00580 
PAD00590 
PAD00600 
PAD0061 0 
PAD 00620 
PAD 00630 
PAD00640 
PAD006S0 
PAD00660 
PA000670 
PAD00680 
PA000690 
PAD00700 
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1900  PhTHk<  lU  )=PATHk<  IW  i+TR  i  <  ly  )>*TR2(  Ii»i  >>*SC>*SSeHT>»Dj< 

GO  TO  < 2400, 2S00j 2300 10 
2000  CONTINUE 

CALL  LT4M<HP,DUM,DIST, 1 ,2,TR1 , DUMMY, DUMMY, 

1  IEM1SS,LEN, MODEL, VIS,  V 1 , V2 , TCRD, 1 CLMAT , I  ERR , 

2  NR, IHAZE,MULDV) 

IF  CK.EQ.I)  CALL  LT4M<:  HP  ,  DUM,  ZENTH.  3, 2,  TR2,  DUMMY,  DUMMY, 

1  IEMISS,LEN, MODEL, VIS,  Vt,V2,TGRD, 

2  ICLMAT,IERR, 


2  NR, IHAZE,MULDV  ) 

DS=0 . 0 

DO  2200  IW=1,IWN 
IF  <K .GT . 1 )  GO  TO  21 00 

SC=3C0E<:  IW,  JL  >+RAT*<  SCOE<  IW,  JU>-3C0E<  lU,  JL  >  > 
RS=RRS<  IW,  JL)+RAT>f<RRS<  IW,  JU  )-RRS<  IW,  JL  )  > 

ANS<  IW)*TR2<  IW)*SC*<RS*SRAYL+<  1  .  0-RS>>*SAER<  IW  >  > 
2100  DPATH=ANS<  IW>*Tft1<  IU>t<DX 
DS=DS+DPATH 

2200  PATHRt IW>=PATHR< 1W>+DP«TH 
DS1=DS1+DS 
D3=DS*0 . 5/^DX 

IF  < I0.EQ.3.AND.K.GT. 1 .AND.DS/DS1 .LT.O.OOl >  RETURN 
IK=<  K/iii  >*20 

IF  < I0.EQ.3. AND. Ik.EQ.K)  DX=DX*2 . 0 
2300  DIST=DIST+DX 
GO  TO  2600 
2400  H2=H24DH 

GO  TO  2600 
2500  JU=JU+1 
JL=JL+1 

IF  <K.EQ. 1 >  RAT=0.5 
H2*<Z<  JU>+Z<  JL>>*0.5 
DX=<  2<  JU  >-2<  JL  )  >/’CTHeD 
2600  CONTINUE 
RETURN 
END 


PAD0071 0 
PADC  0720 
PAD00730 
PAD  0  074  0 
PAD00750 
PAD00760 
PAD00770 
PAD00780 
PAD00790 
PAD00800 
PAD0031 0 
PAD 00820 
PAD00S30 
PAD00840 
PADO0S50 
PAD00860 
PAD  0  087  0 
PAD  0  088  0 
PAD00890 
PAD 009 00 
PAD 0091 0 
PAD  0  092  0 
PAD  0093  0 
PAD  00940 
PAD009i>0 
PAD00960 
PAD00970 
PAD00980 
PAD 00990 
PAD 01 000 
PAD01 01 0 
PAD 01 020 
PAD01 030 
PAD01 040 
PAD01 050 
PAD 01 060 
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SUBROLlTIMt  ZERO  ZtRoOul' 

COMMON  /HO)/  DUMMIE<715;),M,NL,DUMMVS<10e8>,RDATA<300>  ZEROOOZO 

DO  100  1=1,300  2ER00030 

RDATA<I>=0.0  ZER00040 

100  CONTINUE  ZEROOO 

RETURN  ZEROOO 

END  ZEROOO 
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SUBROUTINE  CL  IMAT<  UOCf^T  ,  MONTH,  NHOUft,  I  WIND ,  NPRT  ,  TEMP  .  PRESS ,  RH,  f»H ,  DPCL  I 
1 , VIS,WNDVEL,UINDIR, IPASCT)  CL* 

CL  I 

«>)>«>•<  41 « Ik  >4i*4i4<4t  41  Hi  4i  «■)<>)>  If  Ik  Ik  4titiit<4<  4i<ti4<4i  4>  K  >*•■*■  %  >•■>)■  4i  1*1%  If  4i4>4i  CL  I 

CL  I 

CLIMATOLOGY  MODULE  -  CLIMAT 


PURPOSE  - 


TO  PROVIDE  THE  CENTRAL  EUROPEAN  AND  MID-EASTERN 

CLIMATOLOGY  DATA  REQUIRED  BY  OTHER  MODULES  OF  EOSAEL 


PARAMETER  DESCRIPTION 

LOCAT  -  CLIMATOLOGY  REGION  INDICATOR.  LOCAT 
<l-4>  FOP  CENTRAL  EUROPE  AND 
<5-tO)  FOR  MID-EAST. 


IS  AN  INTEGER 


REGION  I  -  EUROPEAN  LOWLANDS, 

REGION  2  -  EUROPEAN  RHINE  VALLEY, 

REGION  3  -  EUROPEAN  HIGHLANDS, 

REGION  4  -  EUROPEAN  ALPINE, 

REGION  5  -  MIDEAST  DESERTS, 

REGION  6  -  MIDEAST  COASTAL, 

REGION  7  -  MIDEAST  PERSIAN  GULF, 

REGION  8  -  MIDEAST  RED  SEA, 

REGION  9  -  MIDEAST  EASTERN  MOUNTAINS, 
REGION  10  -  MIDEAST  INDUS  VALLEY. 


AND 


MONTH 


NHOUR 


AN  INTEGER  <1-12>  INDICATING  THE  MONTH  OF  THE  YEAR 
MONTH  IS  USED  TO  SELECT  THE  SEASON  WHICH  IS 
APPLICABLE  TO  THE  REGION  LOCAT. 

AN  INTEGER  <0-23)  INDICATING  THE  TIME  OF  DAY  LOCAL 
STANDARD  TIME  <LST).  NHOUR  IS  USED  TO  SELECT  ONE 


FOUR  TIME  PERIODS  OF  THE  DAY  20-02,  03-09,  10-14, 
AND  15-19. 

IWIND  -  ***  NOT  USED  *** 

NPRT  -  A  PRINT  SELECTOR. 

NPRT  LE  ZERO  -  DO  HOT  PRINT  CLIMATOLOGICAL  DATA, 
NPRT  GT  ZERO  -  PRINT  ALL  AVAILABLE  MEANS,  STANDARD 
DEVIATIONS,  AND  PERCENT  OCCURRENCES. 

TEMP  -  MEAN  TEMPERATURE  <C). 

PRESS  -  MEAN  SEA  LEVEL  PRESSURE  <MB>. 

RH  -  MEAN  RELATIVE  HUMIDITY  CPERCENT). 

AH  -  MEAN  ABSOLUTE  HUMIDITY  <GM/CU  M>. 

DP  -  MEAN  DEW-POINT  TEMPERATURE  <C>. 

VIS  -  MEAN  HORIZONTAL  VISIBILITY  <KM>. 

UNDVEL  -  MEAN  WIND  SPEED  <MPS>. 

WINDIR  -  MOST  PROBABLE  WIND  DIRECTION  < DEGREES ) ,  WINDIR  IS 
GIVEN  IN  30  DEGREE  INCREMENTS  <015,045,075,... 
,345), 

IPASCT  -  INDICATOR  <1-6)  FOR  THE  MOST  PROBABLE  PASQUILL 
STABILITY  CATEGORY  <A-F>. 

CLDHT  -  MEAN  CLOUD  HEIGHT  <KM). 

CLDCVR  -  MEAN  TOTAL  CLOUD  COVER  < PERCENT), 

WNDDIR  -  WIND  DIRECTION  <DEGREES). 

SUBROUTINES  AND  FUNCTIONS  -  NONE 


CARD  INPUT  -  NONE 


TAPE  INPUT  - 


YES.  BE  SURE  TO 
UNIT  NCLIMT. 


ASSIGN  THE  CLIMATOLOGY  DATA  TAPE  TO 


CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
Ci-1 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
OFCLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 
CLI 

CLI 

CLI 

CLI 

CLI 

CLI 

CLI 

CLI 

CLI 

CLI 

CLI 

CLI 

CLI 

CLI 


CLI 

4i4tik4iik4tikik4iikik4iik4i4i4i4ilkik4iikik4i4t4iik4iik4iik4i4t4iikik4iik4i]k4i4iik4i4i4iik4i4ilk4iik4i4i4i4i4i4i4i4<4i4i4c4tik4t4i4i4fik4iCLI 

CLI 

COMMON  /lOUNIT/^IOIN, IOOUT,IPHFUN,LOUNIT, HDIRTU, NCLIMT, KST0R,NPL0TUCL1 
DIMENSION  REGrON<70>,SEASON<8>,H6uR<8>,DATA< ie),DIR< 13)  CLI 

CLI 

DATA  REGI0N/'4HEUR0,4HPEAN,4H  L0U,4HLAND,  4HS  ,  CLI 

1  2*4H  ,4HEUR0,4HPEAN,4H  RHI,4HNE  V,4HALLE,4HY  ,4H  ,4HEUR0,CLI 

2  4HPEAN,4H  HIG, 4HHLAN, 4HDS  . ,4HeUR0,4HPEAN,4H  ALP,4HIHE  ,CLI 

3  3*4H  ,4HMIDE,4HAST  ,  4HDESE , 4HRTS  ,  3>*4H  ,  4HMIDE  ,  4HAST  ,4HC0ACLI 


00010 
00020 
00030 
00040 
00050 
0  0060 
00070 
0  0  080 
00090 
001  00 
00110 
00120 
00130 
0014  0 
00150 
0  0 1  0 
00170 
C0180 
00190 
00200 
0021  0 
00220 
00230 
00240 
00250 
0  0260 
00270 
0  0280 
00290 
00300 
0031  0 
0  0320 
00330 
0034  0 
00350 
00360 
0037  0 
00380 
00390 
0  04  00 
0041  0 
00420 
00430 
00440 
00450 
00460 
00470 
00480 
00490 
00500 
0051  0 
00520 
00530 
00540 
00550 
00560 
0  0570 
00580 
00590 
00600 
00610 
00620 
00630 
00640 
00650 
00660 
00670 
00680 
00690 
00700 
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4S,4HTAL  ,3*4H  , 4HMIDE, 4HAST  , 4HPERS, 4HI AN  .4NGULF.2*4H  ,4HMICH 

5DE,4HAST  , 4HREP  , 4HSEA  ,3*4H  . 4HM1DE, 4HAST  , 4HEA5t , 4HERH  ,4HM0IJCLI 

6N, 4HTAIH, 4HS  , 4HMI DE^ 4HAST  ,4HINDU,4HS  VA  .  4HLLEY , 2*4H  /  CLX 

DATA  SEAS0N/4HWIHT,4HER  ,4HSPR1,4HNG  ,4HSIJMM,4HER  ,4HAIJTU,4HMN  CLI 
1  /  CLI 

DATA  H0UR/'4H2 0-0, 4H2  ,4H03-0,4H9  ,4H10-1,4H4  ,4H15-1,4H9  /CLI 

DATA  D1R/4H  0t5,4H  045, 4H  075, 4H  105, 4H  135, 4H  165, 4H  195, 4H  225,  CLI 
14H  255, 4H  285, 4H  315, 4H  345, 4H  VBL/  CLI 

POSITION  THE  TAPE  NCLIMT  FOR  READING  CLI 

CLI 

REWIND  NCLIMT  CLI 

CLI 

SKIP  OVER  ALL  DATA  FOR  REGIONS  1 , 2, . . . , LDCAT-1  CLI 

CLI 

IF<LOCAT.LT. 1  .OR.LOCAT.GT. lOi  LOCAT-1  CLI 

LSKIP=1 056*< LOCAT-1 >  CLI 

CLI 

SKIP  OVER  DATA  FOR  SEASONS  1 , 2,  SEASON- 1  FOR  REGION  LOCAT  CLI 

CLI 

HSEASH=1  CLI 

IF<M0NTH.GE,3.AND.M0i!TH,LE,5)  NSEASN=2  CLI 

IFc' MONTH .  GE .  6 .  AND ,  MONTH .  L£ .  8  >  N5EASN=3  CLI 

IFtMONTH.GE.S.AHD.MONTH.LE. 10)  H3EASN=4  CLi 

IFc' LOCAT  .  GE  .  5  .  AND  .  MONTH  ,  EO  ,  1  1  >  NSEASH=4  CLI 

NSK I P=LSK I P+ 1 76*<  NSEASH- 1  >  CLI 

CLI 

, PERIOD-1  FOR  REGION  CLI 


SKIP  OVER  DATA  FOR  TIME  PERIODS  0, 1 PERIOD-1  FOR  REG! 
LOCAT  DURING  SEASON. 

NTIME=1 

1F<  HHOUR , GE , 3 . AND , HHOUR . LE . 9  >  NTIME=2 
IFcNHOUR.GE. 1 O.AND.NHOUR.LE. 14>  HTIME-3 
IF< NHOUR . GE . 1 5 . AND . HHOUR . LE . 1 9 )  NTIME-4 
NSKIP=NSKIP+44>»<NTIME-f  ) 

IF<NSKIP.Le. 0>  GO  TO  2 
DO  1  J=1,NSKIP 
READ<NCLIMT,9>  A 

1  CONTINUE 

IF  NPRT  GT  0,  PRINT  A  HEADING  FOR  THE  THERMODYNAMIC  DATA 

2  CONTINUE 

IF<NPRT,LE. 0)  GO  TO  3 
URiTE< lOOUT,  15) 

IL0C=7*L0CAT-6 

IL0Cb=IL0C+6 

WRITE<IOOUT, 10)  <REGI0N< J), J»ILOC, IL0CS),SEAS0N<2*NSEASN-1 >, 
1SEAS0N<2*NSEASN),H0UR<2fHTlME-1  ),HOUR<  2-»NTIME) 

READ  THE  THERMODYNAMIC  DATA  FOR  REGION  LOCAT  AT  NTIME 
DURING  NSEASN. 

3  DO  4  J=1 ,22 

READ( NCLIMT, 1 1  )  NCLASS, < DATA< K ), K=1 , 18  > 

CONVERT  FROM  METERS  TO  KILOMETERS 

DATA<6  )=0. 001>t<DATA<6  ) 

DATA< 1 0>=0, 001*DATA< 1 0) 

IF  NPRT  GT  0,  PRINT  THE  THERMODYNAMIC  DATA 

IF<NPRT.LE.O)  GO  TO  4 

URITE< lOOUT, 12)  NCLASS, < DATA< K ), K-1 ,18) 

4  CONTINUE 

EXTRACT  THE  VALUES  OF  TEMP,  PRESS,  RH,  AH.  DP,  VIS,  AND 
UNDVEL . 


0071  I' 
0072v, 
00730 
00740 
00750 
0  0760 
00770 
00780 
00790 
00800 
0081  0 
00820 
00830 
0  084  0 
00850 
00860 
0  087  0 
0  088  0 
00890 
00900 
0091  0 
00920 
0  0930 
0  094  0 
0  0550 
00960 
00970 
00980 
00990 
01000 
01010 
01  020 
01  030 
01  040 
01  050 
01  060 
01070 
01080 
01  090 
011  00 
01110 
01120 
01130 
0114  0 
01150 
O'  ’  60 
011,-0 
0118  0 
01190 
01200 
01210 
01  220 
01230 
01240 
01250 
01260 
01270 
01280 
01290 
01300 
01310 
01320 
01330 
01340 
01350 
01360 
01370 
01380 
01390 
01400 
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TEMP=DATA<  2  > 

DP=C)ATA<3; 
hH=DhTA<  4  ) 

RH=DATA<5:> 

VIS=DATA<  6  > 

PRESS=DATA<  7> 

UlNDVtL=DATA<  8  > 

DETERMINE  THE  VALUE  OP  IPASCT 

IPASCT=1 
FRE£i=DATA<;  i  3  > 

Du  5  J«2,6 

IF<OATA< J+12>.LE ,FREQ>  GO  TO  5 
FREO=DATA<  J+12  > 

IPASCT=J 
a  CONTINUE 

GET  TO  THE  WIND  DATA  ON  NCLIMT 

NSt<iP=<  NSKIP-LSkIP  >/44 
NSKIP  =  44*<  t5-NSKIP  >+22t<NSt<IP 
DO  ib  J=i,NSkIP 
READ<NCLIMT.9)  A 
16  CONTINUE 

IF  NPRT  GT  0,  PRINT  A  HEADING  FOR  THE  WIND  DATA 

IFcNPRT.LE. 0)  GO  TO  6 

WRITE< lOOUT, 13  )  < DIR<  d > , J=1 , 1 3 > 

READ  THE  WIND  DATA  FOR  REGION  LOCAT  AT  NTIME  DURING  NSEASN 

6  DO  7  J=1,22 

READ<NCL1MT, 14)  NCLASS,<DATA<K),k=t , 14) 

IF  NPRT  GT  0,  PRINT  THE  WIND  DATA 
IFCNPRT.LE. 0)  GO  TO  7 

WRITE< lOOUT, 17)  NCLAS8 . < DATA< k >, k«1 , 14) 

7  CONTINUE 

DETERMINE  THE  VALUE  OF  WINDIR 
NDIR=1 

FREC(=DATA<2> 

DO  8  J=2, 1 2 

IF<DATA< d+1 ).LE,FREQ)  GO  TO  8 
FREQ=DATA<  J+1  ) 

NDIR=J 

8  CONTINUE 
WINDIR»30*NDIR-15 

RETURN  FROM  CLIMAT 

RETURN 

FORMAT  STATEMENTS 


CLIui41 0 
CLI01420 
CLl 01 430 
CLI01440 
CLIO  145  0 
CLI 01460 
CLI01470 
CL  I  01 480 
CLI 01 490 
CLI01500 
CLI 01 51 0 
CLI 0 1 520 
CLI 01530 
CLI01540 
CLI  01  5:. 0 
CLI 01 560 
CLI  01  5.'  0 
CLI 01 580 
CLI 01590 
CLI 01 600 
CLI 01 61 0 
CLI01620 
CLI01630 
CLI01640 
CLI01650 
CLI01660 
CLI 01 670 
CL101680 
CLI 01690 
CLI01700 
CL10171 0 
CLI 01 720 
CLI 01 730 
CLI01740 
CLI01750 
CLI01760 
CLI 01 770 
CL101780 
CLI01790 
CLI01800 
CLI0181 0 
CLI 01 820 
CLI 01 830 
CLI01840 
CLI 01 850 
CLI 01860 
CLI 01 370 
Ci_I01880 
CLI01690 
CLI01900 
CLI0191 0 
CLI01920 
CLI01930 
CLI01940 
CLI01950 
CLI 01 960 
CLI01970 
CLI01980 


CLI01990 

9  FORMATCAl)  CLI 02000 

10  F0RMAT<25H1  EOSAEL  CLIMATOLOGY  FOR  ,7A4,8H  DURING  ,2A4,4H  AT  , 2A4 . CLI 020 1 0 

17H<LST).  7/^1 26H  CLASS  FREOCY  MEAN  MEAN  MEAN  MEAN  MEAN  CLI  02020 

2  MEAN  MEAN7STDEV  MEAN  MEAN/STOEV  FREQCY  FREQCY  FREGCY  FREQCY  FREQCLI 02030 
3CY  FREQCY7126H  NO.  CLASS  TEMP  DP  AH  RH  VIS  PCLI02040 

4RESS  UNDVEL  CLDHT  CLDCVR  A  B  C  D  E  CLI 02050 

5  F  /'126H  <Ji)  <C>  <C)  <GM/CU.M>  <  5i  >  <  kM  >  <CLI02060 

6MB)  <MPS>  <KM)  <X)  <X>  <  J4 )  <  fi )  <X>  <X>  CLI02070 

7  <X)  />  CLI02080 

11  F0RMAT<6X, I3,5F5. 1 ,F7. 0,F6. 1 ,2F5. 1 ,F6. O/SPS. 1  )  CLI02090 

12  FORMAT<  15,  F9. 1 , 4F7 . 1  ,  F7 , 3,  F7 . 1  ,  F4 . 1 ,  1  Hz',  F4 . 1  ,  F7 . 3 ,  F6 . 1  ,  1  H/,  F5 . 1 ,6FCLI  021  00 
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t  ?. t )  CL  I 

13  FORMAT<  1H0.-’7H  CLASS  .  1 4<  7H  FREQCV)714H  NO.  CLASS.  13<7H  UNDt)IR>CLI 

1/1  0X,3H<;o,  IX,  13<2X,  A4, 1XV14X,  1  3<  3X ,  3H<  ;0,  1  X  )/ )  CL  I 

14  F0RMAT<6X,  13,  14F5.  1  :>  CLI 

15  FORMAK 18H1CLIMAT0L0GY  M0DEL///39H  DEFINITIONS  OF  METEOROLOGICAL  CLI 

1CLASSES//4SH  CLASS  1  =  FOG,  HAZE  AND  MIST  WITH  VIS  LT  I  KM./53H  lCLI 
2LASS  2  =  FOG,  HAZE  AND  MIST  WITH  1  LE  VIS  LT  3  KM . /53H  CLASS  3  =CLI 

3  FOG,  HAZE  AND  MIST  WITH  3  LE  VIS  LT  7  KM./48H  CLASS  4  =  FOG,  HRZCLI 

4E  AND  MIST  WITH  VIS  GE  7  KM./34H  CLASS  5  =  DUST  WITH  VIS  LT  3  KM. CLI 
5/34H  CLASS  6  =  DUST  WITH  VIS  GE  3  KM./53H  CLASS  7  =  DRIZZLE,  RAIcLI 
6N  AND  TSTMS  WITH  VIS  LT  1  KM../58H  CLASS  8  =  DRIZZLE,  RAIN  AND  Ti>TCLI 
7MS  WITH  1  LE  VIS  LT  3  KM . /S8H  CLASS  9  =  DRIZZLE,  RAIN  AND  TSTMS  WCLI 
8ITH  3  LE  VIS  LT  7  KM .  .^53H  CLASS  10  »  DRIZZLE,  RAIN  AND  TSTMS  WITH  CLI 
9VIS  GE  7  KM./34H  CLASS  11  =  SHOW  WITH  VIS  LT  1  KM  . /39H  CLASS  I':  =  CLI 
ASNOW  WITH  1  LE  VIS  LT  3  KM./39H  CLASS  13  =  SNOW  WITH  3  LE  Vlf  lT  ZcLI 

B  KM./34H  CLASS  14  »  SNOW  WITH  VIS  GE  7  KM . /59H  CLASS  15  =  NO  WtATHcLI 


HASS  22  =  ALL  CONDITIONS  COMBINED, 
17  FORMAT*:  15, F9.  i  ,  13F7 . 1  > 

END 


02 1  1  C 
02120 
02130 
02140 
02150 
02 1  6  0 
02170 
02180 
02190 
022  0  0 
02210 
02220 
02230 
02240 
02250 
02260 
02270 
022S0 
02290 
02300 
0231  0 
0232  0 
02330 
02340 
02.530 
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PROuRhM  hGhUS 


PROGRAM  AGAUS 


REVISIOH  DATE  22  JANUARY, 


PURPOSE ! 


TO  C.lLCULATE  EXTINCTION  COEFFICIENTS, 


AND  PRODUCE 


AuXij0oi;0 
AGK 00030 
AGX00040 
AGX00050 
AGX00060 
AGX00070 
AGXOOOaO 


LEGENDRE  EXPANSION  COEFFICIENTS,  PHASE  FUNCTIONS  AND  < OPTIONALLY)  AGX00090 


SCATTERING  FRACTIONS  UNDER  A  VARIETY  OF  CONDITIONS  AND  AEROSOL 
DISTRIBUTIONS  AT  ONE  OR  MORE  UAVELENGTHS.  THE  PHASE  FUNCTION 
IS  NORMALIZED  TO  4  PI  OMEGA  ZERO  AND  MAY  BE  RENORMALIZED  BY 
DIVISION  BY  THE  APPROPRIATE  CONSTANT<S>. 


INPUT 


IDENTIFIER  -  80  ALPHA  CHARACTERS 


CARD  2  -  INTEGER  CONTROL  PARAMETERS!  NWAVE,  NINDX,  IW,  IDSTP, 
NRADI,  IT,  MQRTE,  lANG,  lEO,  NEOU 
FORMAT  < 1 015) 

NWAVE:  IS  THE  NO.  OF  WAVELENGTHS,  OR  REL .  HUMIDITY  VALUES  TO  BE 
TREATED  IN  THIS  RUN.  SEE  COMMENTS  CIRCA  READ  OF  WAVE,  DUAVE,  ETC. 
N.B,  NWAVE  MUST  BE  . LE ,  1 0  -  TO  CHANGE  THE  NUMBER  OF  WAVELENGTHS 

CHANGE  THE  FIRST  INDEX  OF  ARRAY  OUT<I,J)  TO  AGREE  WITH  NWAVE. 
NINDX!  IS  THE  NBR  OF  AEROSOL  COMPONENTS  WHICH  WILL  HAVE  DIFFERENT 
OPTICAL  CONSTANTS,  MASS  DENSITIES  OR  MASS  CONCENTRATIONS. 

IW:  =0  WILL  SET  THE  REFRACTIVE  INDEX  OF  THE  AEROSOL  EQUAL 

TO  THAT  OF  WATER  AT  THE  INPUT  WAVELENGTH  AND  TEMP.  IF  IW  . NE .  0 
AND  HANELS  GROWTH  FACTOR  IS  ZERO  <eMUA*0.  -  CARD  5),  THEN  THE 
INPUT  REFRACTIVE  INDEX  <EMA,CAYA>  WILL  BE  USED  FOP  THE  AEROSOL. 
OTHERWISE  THE  REFRACTIVE  INDEX  IS  ADJUSTED  PER  HANEL  < SEE  BELOW). 
IDSTPi  IDENTIFIES  TYPE  OF  AEROSOL  SIZE  DISTRIBUTION  TO  BE  USED. 
NRAOli  HO.  OF  PARTICLE  RADII  TO  BE  EXPECTED  FOR  IDSTP=0  OR  3: 

THE  INPUT  VALUE  OF  NRADI  IS  IGNORED  FOR  IDSTP  NOT  ZERO  OR  3. 

NRADI  MUST  BE  .LE.  1 +2** JOI«C(« 2 )  -  C.F.  BLOCK  DATA 
IT!  IS  THE  NUMBER  OF  GAUSS-LEGENDRE  ANCLES  < ORDER  OF  EXPANSION) 

IF  ONLY  EXTINCION  COEFFICIENTS,  ETC.  ARE  DESIRED,  I.E.  NOT  PHASE 
FUNCTIONS,  THEN  SET  -IT-  EQUAL  TO  ONE. 

MQRTE!=12345  WILL  CAUSE  PRINTS  OF  MIE  EFFICIENCY  FACTORS  AT 
EVERY  VALUE  OF  PARTICLE  RADIUS  USED  IN  THE  MIE  CALCULATIONS; 

SET  MQRTE  =  0  IF  SUCH  PRINTS  ARE  NOT  DESIRED. 

IANG:=0  FOR  COMPUTATIONS  OF  PHASE  FN .  AT  -IT-  GAUSS  LEGENDRE 
QUADRATURE  ANGLES!  IANG=1  FOR  COMPUTATIONS  OF  PHASE  FN  AT 
-IT-  EQUALLY  SPACED  ANGLES  BETWEEN  0  AND  »80  DEGREES. 

IANG=2  WILL  ALLOW  -IT-  USER  SUPPLIED  ANGLES  TO  BE  READ  - 
FORMAT  <I6F5.1).  THIS  REQUIRES  AT  LEAST  ONE  CARD  OF  TYPE  2A , 

IF  lANG.GT.O  NO  LEGENDRE  COEFFICIENTS  WILL  BE  GENERATED. 
IE0:=1,2,3,4  WILL  CONSTRUCT  A  PHASE  FUNCTION  FILE  (ON  NEOU). 


NWAVE:  IS  THE  NO. 


65  PREDETERMINED  ANGLES 
65  PREDETERMINED  ANGLES 
USER  INPUT  ANGLES 
USER  INPUT  ANGLES 
65  PREDETERMINED  ANGLES 


AGX001 00 
AGXOOl  1  0 
ACXOC1I2O 
AGXOOi 30 
AGXOOl 40 
AGXOOi 50 
AGXOOl bO 
AGXOOI 70 
AGXOOI SO 
AGXOOi 90 
AGX00200 
AGX002i 0 
AGX00220 
AG.X00230 
AGX00240 
AGXu0250 
AGX00260 
AGXOOZc  0 
AGX00280 
AGX 00290 
AGX00300 
AGX003i 0 
AGX00320 
AGX00330 
AGX00340 
AGX00350 
AGX 00360 
AGX00370 
AGX00380 
AGX00390 
AGX 004 00 
AGX004i 0 
AGX00420 
AGX00430 
AGX00440 
AGX 00450 
AGX00460 
AGX 00470 
AGX 00480 
AGX00490 
AGX 005 00 
AGXOOSi 0 
AGX 00520 
AGX00530 


IE0=1  65  PREDETERMINED  ANGLES  INDIVIDUAL  WAVELENGTHS  ONLY  AGX00500 

IE0=2  65  PREDETERMINED  ANGLES  COMPOSITE  WAVELENGTH  ONLY  AGXOOSi 0 

IE0=3  USER  INPUT  ANGLES  INDIVIDUAL  WAVELENGTHS  ONLY  AGX00520 

IEu=4  USER  INPUT  ANGLES  COMPOSITE  WAVELENGTH  ONLY  AGX00530 

IE0=5  65  PREDETERMINED  ANGLES  INDIVIDUAL  «.  COMPOSITE  WAVELENGTHAGX00540 

THE  COMPOSITE  WILL  BE  THE  LAST  DAAGX00550 
SET  WRITTEN  ON  UNIT  -NEOU-  .  AGX 00560 

FOR  USER  INPUT  ANGLES  SEE  -IT-  AND  lANG  ABOVE.  THE  COMPOSITE  AGX00570 
VALUES  ARE  SIMPLE  AVERAGES  OVER  THE  NUMBER  OF  WAVELENGTHS.  AGX00580 

THIS  FILE  WILL  CONTAIN  THE  FOLLOWING  INFORMATION!  AGX00590 

i>  ANGLES  <65  MAX)  -  FORMAT< 1 1 < F6 , 2, 1 X ) )  AGX00600 

2) NBR  OF  ANGLES,  PHASE  FUNCTION  IDENTIFIER  <-0»  IMPLIED  USER  INPUTAGXO 06 1 0 

IN  EOSAEL),  WAVELENGTH  <UM),  SINGLE  SCATTERING  ALBEDO,  EXTINCTION  AGX00620 
AND  SCATTERING  COEFFICIENTS  IH  INVERSE  KM  -  AGX00630 

FORMAT  <2< 12, 1X),F5.2, 1X,F8.6, 1X,2<ei2.6, iX>)  AGX00640 

3)  PHASE  FUNCTION  AT  ANGLES  SPECIFIED  ABOVE.  N.B.  THE  PHASE  FUNCTAGX00650 

AS  WRITTEN  OUT  HERE  IS  NORMALIZED  TO  4  PI  OMEGA  ZEROi  THE  ROUT1NEAGX00660 
IN  EOSAEL  WILL  RENORMALIZE  THE  PHASE  FUNCTION  TO  ONE.  AGX00670 

FORMAT  <6<E12.6, IX))  AGX00680 

NEOU*  UNIT  NUMBER  UPON  WHICH  EOSAEL  PHASE  FUNCTION  IS  TO  BE  STORED.  AGX00690 

AGX00700 
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CARD  2A  -  USER  SUPPLIED  SET  OP  -IT-  ANGLES  FORMAT  ( ) 6F5 . 1  > 

16  VALUES  PER  CARD,  MORE  THAN  1  CARD  MAV  BE  NEEDED. 

THIS  CARD  IS  ONLY  NEEDED  WHEN  IANG=2 , 

CARD  3  -  DISTRIBUTION  PARAMETERS:  ONLY  ONE  TYPE  PER  RUN, 

FORMAT  <6E12.6)  -  READ  IN  AGXPl 

♦*:***  all  DIMENSIONS  ARE  IN  MICRONS  ***** 

TYPE  0.  USER  SUPPLIED  -  NRADI  CARDS,  ONE  VALUE  OF  RADIUS  AND 

NUMBER  DENSITY  PER  CARD.  IT  IS  SUGGESTED  THAT  DELTA  BE 
INPUT  NO  GREATER  THAN  ,001  IN  ORDER  TO  FORCE  THE  MAXIMUM 
NUMBER  OF  RADII  TO  BE  USED  DUE  TO  THE  POSSIBLE  IRREGULAR 
NATURE  OF  THIS  DISTRIBUTION. 

R<I>,  FF<I),  1  =  1,  NRADI 
TYPE  1 .  LOG-NORMAL 

RBAR,  SIGMA,  RLO,  RHI 
TYPE  2,  DOUBLE  EXPONENTIAL 
RLO,  RHI,  CUE,  A,  B 
TYPE  3.  DEIRMENDJIAN  MODEL  C 

-  NO  INPUi  - 

TYPE  4,  POWER  LAU  < JUNGE  i 
RLO,  RHI,  CUE,  A 
TYPE  5.  MODIFIED  GAMMA 

RLO,  RHI,  RC,  ALF,  GAM 
TYPE  6.  MODIFIED  GAMMA  FOG  MODEL 

RLO,  RHI,  RC,  ALF,  GAM,  ELUC 
TYPE  7.  POWER  LAW 
VIS 

TYPE  8.  CONTINENTAL  BIMODAL 

-  NO  INPUT  - 

TYPE  9.  MARITIME  BIMODAL 

-  NO  INPUT  - 
TYPE  10. URBAN  BIMODAL 

-  HO  INPUT  - 

TYPE  11. USER  SUPPLIED  BIMODAL 

FOA,  RBARA,  SGA,  FOC,  RBARC,  SGC 
TYPE  12, MARSHALL-PALMER  RAIN  MODEL 
RAIN 

CARD  4  -  CONTROL  PARAMETERS:  FORMAT  <6E12.6;) 

WAVE,  DWAVE,  RELHUM,  DEHSH,  TEMP,  DELTA 

FOR  LOOPING  OVER  RELATIVE  HUMIDITY  ADD 

NWAVE-1  CARDS  CONTAINING  RELHUM, TEMP  -  FORMATC 2E 1 2 , 6 > 

SEE  OWAVE  BELOW. 

WAVE:  IS  WAVELENGTH  IN  MICROMETERS. 

DWAVE:  IS  THE  WAVELENGTH  INCREMENT  IN  MICROMETERS.  IF  DWAVE  IS 
LESS  THAN  1.E-4,  A  SPECIAL  CASE  APPLIES  USED  FOR  LOOPING  OVER 
HWAVE  VALUES  OF  RELHUM:  THE  FIRST  TIME  THIS  CARD  IS  READ  IT 
MUST  CONTAIN  WAVE , DWAVE , RELHUM , DENSH , TEMP , DELTA ;  THE  SECOND  AND 
SUBSEQUENT  TIMES  IT  MUST  ONLY  HAVE  RELHUM, TEMP  ON  IT.  THIS 
ALSO  REQUIRES  REPETITION  OF  CARD  3. 

RELHUM:  IS  RELATIVE  HUMIDITY  IN  PERCENT. 

DENSH:  IS  PARTICLE  NUMBER  PEP  CUBIC  CENTlMtTER, 

USER-SUPPLIED  VALUE  OF  DENSH  WILL  BE  IGNORED  FOR  IDSTP=3  OR  GT  6 
BECAUSE  THOSE  DISTRIBUTIONS  CARRY  PRE-DETERMINED  DENSITY  VALUES. 
ALSO,  IF  DENSH  IS  LESS  THAN  IE-4,  THE  PARTICLE  NUMBER  DENSITY 
WILL  BE  CALCULATED  FROM  MASS  DENSITY  AND  MASS  CONCENTRATION, 

TEMP:  IS  THE  TEMPERATURE  OF  THE  ATMOSPHERE  IN  DEGREES  C. 

DELTA:  IS  THE  CONVERGENCE  CRITERION  WITHIN  A  PARTICULAR  SIZE 

RANGE  INTERVAL:  HALVING  IS  TERMINATED  WHEN  THE  QUANTITY  DEL 
IS  LESS  THAN  DELTA.  ♦•N . B . **  THE  AMOUNT  OF  CPU  TIME  USED  BY 
THIS  PROGRAM  IS  CLOSELY  CONNECTED  WITH  DELTA.  THE  SMALLER  DELTA 
IS  THE  LARGER  YOUR  RUN  TIME  WILL  BE.  IT  IS  SUGGESTED  THAT 
DELTA  BE  SET  EQUAL  TO  .001  FOR  HOST  RUNS. 

CARD  5  -  OPTICAL  AND  PHYSICAL  DATA:  FORMAT  < 4F1 0 . 5 , El 5 . 7 > 

EMA,  CAYA,  EMUA,  RHOA,  CONC 

REPEAT  HWAVE*NINDX  TIMES:  IF  1DSTP=6  THIS  CARD  IS  NOT  NEEDED. 

EMA:  IS  THE  REAL  PART  OF  THE  INDEX  OF  REFRACTION  OF  DRY  AEROSOL. 
CAYA:  IS  THE  IMAGINARY  PART  OF  REFRACTIVE  INDEX  FOR  DRV  AEROSOL. 
*****  CAYA  IS  ASSUMED  TO  BE  NEGATIVE  **** 


AGXOuZI 0 
AGX 00720 
AGX00730 
AGX 00740 
AGX0075U 
AGX 00760 
AGX0U770 


AGX0081 0 
AGXOOS2U 
AGX00830 
AGX0u840 
AGX 00850 
AGX0U860 
AGX 008 70 
AGXOOSbu 
AGX00890 
AGXOOSuO 
AGX0091 0 
AGX 00920 
AGX00930 
AGXO0940 
AGX 00950 
AGX00960 
AGX00970 
AGX0U980 
AGX 00990 
AGXOi 000 
AGX01 01 0 
AGXOI 020 
AGXOI 030 
AGXOI 040 
AGXOI 050 
AGXOI 060 
AGXOI 070 
AGXOI 030 
AGXOI 090 
AGXOI 1 00 
AGXOI 1 1 0 
AGXOI 120 
AGX  01*1 0 
AGXOI 140 
AGXOI 150 
AGXOIIGO 
AGXOI 170 
AGXOI 180 
AGXOI 190 
AGXOI 200 
AGXOI 21 0 
AGXOI 220 
AGX01230 
AGX01240 
AGX 01 250 
ACX01260 
AGXOI 270 
AGX 01 280 
AGX 01 290 
AGX01300 
AGX0t31 0 
AGX01320 
AGX01330 
AGX01340 
AGX01350 
AGX01360 
AGX01370 
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DO  NOT  ENTER  CAYh  WITH  A  NEGATIVE  SIGN  !  M  !  ! 


EMUA 

RHuA 

COHC 


IS  HANEL'S  GROWTH  FACTOR  < MU-BAR >/ACCRETION  COEF . 
IS  THE  MASS  DENSITY<SP.  GRAV j  OF  DRY  AEROSOL. 

IS  THE  MASS  CONCEHTRATIOH<GM/CC >  OF  DRY  AEROSOL, 


END  INPUT 

MISCELLANEOUS  INFO 

THE  INPUT  AND  OUTPUT  UNITS,  ALONG  WITH  A  EXTRA,  CURRENTLY  UNUSED, 
UNIT  <NUHIT)  ARE  ASSIGNED  VALUES  IN  THE  BLOCK  DATA  SUBROUTINE. 

REL.  HUMIDITY  TREATMENT  PER  G.  HANEL/’1976  ADV .  IN  GEOPHYS. 

FOR  DIMENSION  3I2E3  REFER  TO  THE  BLOCK  DATA  SUBROUTINE.  THERE 
ALSO  IS  A  ERROR  ROUTINE  < DIMER >  THAT  CKS  ON  YOUR  DIMENSIONS. 


SCATTERING  FRACTIONS  REQUIRE  THAT  NUNIT  BE  ASSIGNED  AND 


SIMkLE  CHANGE  BE  MADE  IN  SUBROUTINE  AGXP3 : 
REFER  TO  THAT  SUBROUTINE, 

THE  FUNCTION  ATANaC  SQRT<  1  . -C<  I  >, C<  I  >  > 
TO  ARCOS<C< I )>. 


FOR  FURTHER 


IS  EQUIVALENT 


A 

INFO 
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AGX01 380 
AGX01390 
AGX01 400 
AGXO 1410 
AGX01 420 
AGX01430 
AGX01 440 
AGX01 450 
AGX01 460 
AGX01 470 
AGXO 1480 
AGXOi 490 
AGX01 500 
AGX0151 0 
AGXOi 520 
AGX01  5..'0 
AGXOi 540 
AGX01550 
AGXOI 360 
AGX01570 
AGXOI 5S0 
AGX01590 
ACX01600 
AGXOI 61 0 
AGXOI 620 
AGXOI  6  jiO 
AGXOI 640 
THE  AGXO 1650 
AGX01 660 
AGX01670 
AGXOI 680 
AGXOI 690 
AGX01700 
AGXOI 71 0 
AGXOI 720 
AGX01730 
AGX01740 
AGXOI 750 


REAL  KEXTT,KSCAT,KBAKT  AGX01770 

COMMON  XAGXMX  C< 65  ), W< 65 >, OLT< 65 ), JDIMCKC 3 >  AGX01760 

COMMON  XPTIX  F<513),R<513>,DR<3>,RR<9),FF<514>  AGX01790 

+,NRADI,PI, IDSTP,NKG,NHALV,NI  AGX01800 

COMMON  /PT2/'  PC<65),0L<65),RMS<65),PSUM<65>,PSUMT<65>,P<65)  AGX01810 

COMMON  /lO/  lOIN, lOUT, NUNIT, IEO,NEOU  AGX0I820 

DIMENSION  OUTC 1 0,4),NTITLE<40>  AGX01830 

C  READ  AND  WRITE  IDENTIFIER  *****  AGX01840 

READ  <I0IN,88)  < NTITLE< I  ), 1  =  1 , 40 >  AGX01850 

88  FORMAT  <40A2>  AGX01860 

WRITE  <I0UT,89)  < NT1TLE< I >, 1= 1 , 40 >  AGX01870 

89  FORMAT< INI ,4082// >  AGX018S0 

C  *****  read  INTEGER  CONTROL  PARAMETERS  FOR  THIS  RUN  AGX01890 

READ  <IOIN,103j  NWAVE , NINDX , I W, IDSTP, NRAD I , IT , MQRTE , I ANG , IEO, NEOU  AGX01900 
C  ERROR  CHECKS  AGXOI 910 

IF  <IT,LE.O)  IT=1  AGX01920 

IF  < IT.GT. JDIMCK< 1 ))  CALL  DIMER< 1 >  AGX01930 

IF< JDIMCK< 1 >.LT.65  )  WRITE< lOUT, 1 29 >  AGX0194U 

C  CHECK  FOR  CONFLICTING  EOSAEL  OPTIONS  AGX0f950 

IF  <<IE0.EQ,2,0R.IE0.EQ.5>.AHD.NWAVE.EQ,1 >  IE0=1  AGX01960 

IF  << IE0.EQ.4.0R,1E0,EQ.5).AND.NWAVE.EQ.1 >  1E0=3  AGX01970 

IF  <IE0,GT.1 .AND.IT,GT.65)  GO  TO  20  AGX01980 


EOSAEL  OPTION 

IF  < lEO.EQ. 1 .OR, IE0.EQ,2,0R. IE0.EQ.5)  IT=65 
JDIMCK<  3  >- 1 +2** JDIMCKX  2  > 

IF  <  IDSTP. GT. 12)  GO  TO  1 
IF  < NWAVE. EQ.O)  NWAVE=1 
IF  < IDSTP. EQ. 12)  IW=1 
IF  <NINDX.LT. 1 .OR, lOSTP.EQ.e.OR. IDSTP.EQ. 12)  NINDX=1 


AGX01990 
AGX02000 
AGX02D1 0 
AGX02020 
AGX02030 
AGX02040 
AGX02050 


WRITE  < lOUT, 1 04)  NWAVE, NINDX, IW, IDSTP, NRADI, IT, MQRTE, lANG, IEO, NtOUAGX02060 
IF  <IW,EQ.O)  WRITE  <I0UT,122)  AGX02070 
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USED  IH  SUMMATIONS 


3 

C 

C 

C 

7 

C 


23 

21 

C 


INITIALIZE  QUANTITIES 
DO  2  I-1 , IT 
OLTC 1 >=0. 

P3UMT<  I  .)=0.E0 
UiAvAvG=0 . 

ALBDOT»0 . 
kEXTTsO.EO 
kSCAT=0 . EO 
KBAKT=«0  .  EO 
CATTN=0.E0 
ITT=IT-1 

PI=3, 1415S265358S8E+00 

IF  <  lEO  .  EQ  .  1  .  OR  .  lEO  .  EQ  ,  2  .OR  .  lEO  .  EG  .  5  >  GO  TO  3 
IF  << lANG.EQ. 1  >.OR.< IANG.EQ.2>)  GO  TO  3 

WHEN  IANG=0  ROUTINE  GUSET  IS  CALLED  TO  SET-UP  THE  ABSCISSAE  AND 
WEIGHTS  USED  FOR  CALCULATING  THE  PHASE-FUNCTION  AT  -IT-  POINTS 
USED  FOR  NUMERICAL  INTtGRATION  VIA  GAUSS-LEGENDRE  QUADRATURt  AMD 
THE  PHASE  FUNCTION  EXPANSION  COEFS,  OL<  >. 

THE  WEIGHTS  ARE  PLACED  IN  THE  ARRAY  W< ),  AND  THE  COSINES  OF  THE 
ANGLES  ARE  PLACED  IN  THE  ARRAY  C<  ). 

CALL  GUSET<IT> 

IF  < ITT.LT.3)  ITT=3 
GO  TO  7 

CALL  ANGLE  <PI,IANG,IT> 

SUBROUTINE  ANGLE  IS  CALLED  WHEN  1ANG=1  OR  2  TO  SET  UP  THE 
ANGLES  AT  WHICH  PHASE  FUNCTIONS  WILL  BE  CALCULATED.  ANGLES 
GO  INTO  ARRAY  W< >  AND  COSINES  IN  C<>. 

CONTINUE 

WRITE  ANGLES  FOR  EOSAEL  DATA  FILE 
IF  <  lEO.LE. 0)  GO  TO  21 
DO  22  1*1 ,  IT 

C<  1  >=180.*ATAN2<SQRT<  1  . -C<  I  )*’f2>,C< 

ITP1*IT+1 

IF  < ITPl .GT. JDIMCK< 1 ))  ITP1»IT 

IF  < IT.LT.65.AND. JDIMCK< 1 ).GT.65)  C< ITPl >=999 . 98 
WRITE  <NE0U,125)  <C< I  ), I«1 , ITPl  ) 

DO  23  1=1, IT 

C<  I  >=COS<C<  1  )>*<PI/180.  > 

CONTINUE 

DETERMINE  DETAILS  OF  AEROSOL  SIZE-DISTRIBUTION  VIA  AGXP1 
CALL  AGXP1<DENS,FSUM,V0L, JDIMCK) 

IF  < IDSTP.EQ.S.OR, I0STP,EQ.12>  ELWC=DENS 

DRVVOL  IS  THE  AVERAGE  VOLUME  OF  THE  DRV  AEROSOL  PARTICLES  IN 
CUBIC  MICROMETERS. 

DRVvOL=VOL 

READ  INPUT  PARAMETERS  *** 

READ  <IOIN,105)  WAVE, OWAVE,RELHUM,DENSH, TEMP, DELTA 
IF  CNWAVE.EQ.l)  DWAVE=O.EO 

WRITE  <IOUT,106>  WAVE, DWAVE, RELHUM, DENSH, TEMP, DELTA 
IF  <NINDX.GT.1>  WRITE  <10UT,107)  NINDX 
IF  <<DWAVE.LT. 1E-04).AND.<NWAVE.GT. 1 ))  WRITE 
IF  <<DWAVE.GE.1E-04),AND.<NWAVE,GT,1 ))  WRITE 


IF  < DENSH.lt. IE-04)  WRITE  <IOUT,110) 
ENWAV*  FLOATCNWAVE) 

IF  < DWAVE. LT. 1 .E-4>  GO  TO  8 
WAVE=WAVE-DWAVE 
DO  9  NWV=1,NWAVE 
IF  < DWAVE. GT. 1 .E-4)  GO  TO  10 
IF  <NWV.ECI.  1  )  GO  TO  1  1 


<  lOUT, 1 08) 
<IOUT,109) 


NWAVE 

NWAVE 


READ  <IOIN,105)  RELHUM, TEMP 
GO  TO  11 

10  WAVE-WAVEfDWAVE 

1 1  VOL=DRVVOL 

C  DETERMINE  WHETHER  THE  USER  SUPPLIED  PARTICLE  NUMBER  DENSITY  DENSH 

C  SHOULD  BE  OVERIDDEH  BECAUSE  THE  CHOSEN  IDSTP  CASE  HAS  FIXED 

C  PARAMETERS,  ANDZOR  IF  NUMBER  DENSITIES  ARE  TO  BE  CALCULATED  LATER 
C  FROM  THE  AVG  PARTICLE  VOLUME,  MASS  DENSITY,  AND  MASS  CONCENTRATIONAGX02740 

LLLL-0  AGX02750 

IF  <IDSTP.EQ.6)  GO  TO  12  AGX02760 

IF  < IDSTP.EQ.3.0R. IDSTP,GE.7)  LLLL*1  AGX02770 


AGX02080 
AGX02090 
AGX021  Oft 
AGX021  1  u 
AGX02120 
AGX02130 
AGX021 40 
AGX021 50 
AGXOSi 60 
AGX021 70 
AGX021 80 
AGXu2190 
AGX02200 
AGX0221 0 
AGX02220 
AGX 02230 
AGX0224  0 
AGX 02250 
AGX02260 
AGX02270 
AGX02280 
AGX02290 
AGX023u0 
AGX023i 0 
AGX02320 
AGX02330 
AGX02340 
AGX 02350 
AGX 02360 
AGX 02370 
AGX02380 
AGX02390 
AGX02400 
AGX0241 0 
AGX 02420 
AGX02430 
AGX02440 
AGX02450 
AGX02460 
AGX02470 
AGX02480 
AGX02490 
AGX02500 
AGX0251 0 
AGX02520 
AGX02530 
AGX 02540 
AGXOC^SO 
AGX02bu0 
AGX02570 
AGX025S0 
AGX02590 
AGX02600 
AGX0261 0 
AGX02620 
AGX02630 
AGX02640 
AGX02650 
AGXC2660 
AGX02670 
AGX02680 
AGX02690 
AGX 027 00 
AGX0271 0 
AGX02720 
AGX02730 
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IF  LLLL.Eu.1i  GO  TO  12  f1Gx027»0 

IF  < DENSH . LE . 1  . E-4  i  GO  TO  12  rtGX02790 

LLLL=1  rt&X'2S00 

DE1sS=DENSH  (10X02810 

12  CONTINUE  AGX02820 

RESTRICT  RELATIVE  HUMIDITY  TO  MAX  OF  99  PERCENT.  AGXC283C 

IF  '.RELHUM.GE.SS.E+OOi  RELHUM=99 . 0E+ 00  AGX02840 

WRITE  <IOUT,111)  RELHLIM,WAVE  HGX02850 

IF  < DENS .EQ . 0 . 0  i  DENS=1.0E+00  AGX02860 

GNU=1 ■ 0E+04XWAVE  AGX02870 

Ii-  c  IDSTP  .  EQ  .  b  .  OR  .  iuSTP  .  EO  .  1  2  >  DENS=ELIiiC  AGX02880 

DENS  IS  USED  AS  AN  ALIAS  TO  PASS  ELWC  TO  ROUTINE  AGXP2,  AGX02890 

CALL  AG.XP2t  RELHUM,  CT3UM,  CS3UM,  CRSUM,  VOL  ,  TMA3S,  DENS,  QATTN,  TEMP,  AG.XOiiSOO 

1DELTA,NINDX, I W, OLSTAR, 0M2 , LLLL , IT , WAVE , EM . CAY , EMM , MQRTE , PFN2R0  i  AGX0291 0 

LMAX  =  3*IFIX<2  .E+0+PI*EMM>*'Ri:NRAD1  iXWAVE  i  AGX 0292  0 

IF  <LMAX.GT.iTi  WRITE  <I0UT,112i  LMAX, IT  AGX02930 

13  CALL  AGXP3<CTSUM,CSSUM,CRSUM,GNU,DENS,N1NDX,UAVE,EM.CAY,EMM, IT, 0,  AGX02940 

+IAHG>  AGX02950 

SUM  QUANTITIES  OVER  INDEX  HWV .  AGX02960 

DO  14  Ik=1,IT  aGX 02970 

OLT< IK >=OLT< IK  )+OL< IK  )  AGX02980 

14  PSUMT< IK i=PSUMT< IK i+PSUMC IK >  AGX02990 

ALbDOT  BtCOMES  THE  TOTAL  SINGLE  SCATTERING  ALBEDO  AGX03000 

KEXTT  BECOMES  THE  TOTAL  EXTINCTION  COEF .  < PER  KILOMETERi  AGXOSOfO 

KSCAT  BECOMES  THE  TOTAL  SCATTERING  COEF.  < PER  KM >  AGX0s020 

KBAKT  BECOMES  THE  TOTAL  BACK-SCATTERING< RADAR >  COEF  (PER  KMi  AGX03030 

ARRAY  OUTc ,  i  HOLDS  SOME  QUANTITIES  FOR  LATER  PRINTOUTS  AGX05040 

ALBPO=CSSUriXCTSUM  AGX03050 

ALBDOT=ALBDOT+ALBDO  AGXOSObO 

KEXTT=KEXTT+CTSLIM  AGX03070 

KSCAT=KSCAT+CS3UM  AGX030S0 

KBAKT=KBAKT+CRSUM  AGX 03 090 

CATTN=CATTN+QATTN  A&X03100 

WAVAVG=WAVAVG+WAVE  AGX03110 

OUT( Nwv, 1  i=WAVE  AGX03120 

0UT<NWV,2i=RELHUM  AGX03130 

0UT<NUIV,3)*TMASSf  1  .  E5  AGX03140 

OUT(  NWV, 4 )=CTSUM  AGX03)50 

IF  ((NWAVE.GT. 1  i.AND,<DWAVE.GE. 1  .E-04>i  WRITE  (I0UT,113>  NWV  AGX03160 

IF  <<NWAVE.GT.1  ).AND.<DWAVE.LT.1  ,E-04>>  WRITE  <.I0UT,114>  NWV  AGX03170 

EOSAEL  OPTION!  WRITE  NBR  OF  ANGLES,  WAVELENGTH,  SINGLE  SCATTERING  AGX03180 
ALBEDO,  EXTINCTION  COEFFICIENT  (TOTAL  AND  SCATTERING)  FOR  AGX03190 

INDIVIDUAL  WAVELENGTHS.  AGX03200 

IF  <  lEO.EQ.  1  ,OR,  IE0.EQ,3,0R.  IEO.EQ.5)  WRITE  (NE0IJ,127)  AGX03210 

+  IT,WAVE, ALBDO,CTSUM,CSSUM  AGX03220 

EOSAEL  OPTION!  WRITE  PHASE  FUNCTION  FOR  INDIVIDUAL  WAVELENGTHS.  AGX03230 
IF  < lEO.EO . 1 .OR . IE0,EQ,3.0R, lE0.EQ.5i  WRITE  <NE0U,128i  AGX03240 

+  (  PSUM<  I  i,  1  =  1  ,  IT  i  Ag:<03250 

CONTINUE  AGX03260 

END  OF  NWAVE  LOOP  AGX 03270 

IF  (NWAVE.LE.ii  GO  TO  19  AGX 03280 

DIVIDE  BY  NBR  OF  VALUES  OF  NWV  TO  GET  AVERAGED  RESULTS  AGX03290 

DO  16  1=1, IT  AGX03300 

OL< I  )=0L7< 1  i/ENWAV  AGXC3310 

PSUMC  I  i=PSLIMT(  I  iXEHWAV  AGX03320 

CONTINUE  AGX03330 

ALBDOT=ALBDOT.-'EHWAV  AGX03340 

KEXTT=KEXTT/ENWAV  AGX03350 

KSCAT=K3CAT/‘ENWAV  AGX03360 

KBAKT=KBAKT/'ENWAV  AGX03370 

CATTN=CATTNXENWAV  AGX033S0 

WAVAVG»WAVAVGXEHWAV  AGX03390 

WRITE  <I0UT,117i  NWAVE  AGX03400 

WRITE  <I0UT,118)  AGX03410 

DO  18  J=1, NWAVE  AGX03420 

WRITE  <I0UT,119)  <OUT< J, JO), JJ=1 ,4)  AGX03430 

WRITE  <I0UT,123i  KEXTT , KSCAT, KBAKT, CATTN, ALBDOT  AGX03440 

CALL  AGXP3<CTSUM,CSSUri,CRSUM, GNU, DENS, NINDX, WAVE, EM, CAY, EMM, IT, 1 ,  AGX03450 

+1ANG)  AGX03460 

EOSAEL  OPTION!  WRITE  NBR  OF  ANCLES,  WAVELENGTH  , SINGLE  SCATTERING  AGX03470 
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HLBeOO,  EisTINCTrON  COEFPICIEHT  <TOT(>L  hHD  SCATTERING 
COMPOSITE  VALUES, 

IF  <;  IE0.EQ.2  ,OR  .  leO.EQ  .4  .OR.  IfcU.Eu.  5>  UftITE  ';NE0U  .127  > 
^  I T , WA VA VG , ALBDOT , KEXTT , KSCAT 

EOSAEL  OPTION;  WRITE  COMPOSITE  PHASE  FUNCTION. 

IF  <  IE0.EG!.2.0R.1E0.E0.4,0R.  lEO.EQ.S)  WRITE  <HE0U,)28) 
^  <PSUM<  I  >,  1  =  )  ,  IT) 

GO  TO  19 

< lOUT ,120)  IDSTP 
< lOUT,  126  ) 


CONTROL  PARAMETERS:  NWAVE  NIND:<  lU 
NEOU/, 1X,29X.2< 1 2 , 4X > , 1 1 , 3X , 1 2 , 
15,2<2X, 12)) 


IDSTP 


1  WRITE 
19  WRITE 
STOP 

20  WRITE  <  TOUT, 124  > 

STOP 

1 03  FORMAT  < 1 015) 

104  FORMATlIH  ,78HINTEGER 
+01  IT  MQRTE  lANG  lEO 
+3X, 13, IX, 13, IX, 15, IX 

1 05  FORMAT  <6E12.6) 

106  FORMATS iH  ,X,17H  INPUT  PARAMETERS/, tX, 6X,9HWAVE  =  ,E12.6,8H 

+  ONS,-',  1X,6X,9HDWAVE  =  ,E12.6,8H  Ml  CRONS/ ,  1  X ,  6X ,  9HRELHUM  =  ,E1 

+  3H  PERCENT/, IX, 6X,9HDENSH  =  ,E12.6,13H  PART  I CLES/CC/ , 1 X , 6X , 

+9HTEMP  =  ,E12.6,6H  DEG  C/ , 1 X , 6X , 1 9HDELTA  < CONVERGENCE  , 

+13HCRITERI0N)  =  ,E12.6) 

107  FORMAT  </,1H  ,29HL00PING  OPTION  IN  EFFECT  FOR  ,12, 

+19H  AEROSOL  COMPONENTS) 

108  FORMAT  </,1H  ,38HRELATIVE  HUMIDITY  OPTION  IN  EFFECT  FOR  ,12, 
+7H  VALUES) 

109  FORMAT  </,1H  , 40HWAVELENGTH  LOOPING  OPTION  IN  EFFECT  FOR  ,12, 
+12H  WAVELENGTHS) 

110  FORMAT<1H  ,52H*%*  PARTICLE  NUMBER  DENSITY  WILL  BE  CALCULATED 
+  ,41H  MASS  DENSITY  AND  MASS  CONCENTRATION  =»■••+) 

111  FORMAT  <  IHl  ,//,  1X,33HRELATIVE  HUMIDITY  FOR  THI-S  RUN  =  ,F6.2, 

+  25H  PERCENT.  WAVELENGTH  =  ,F10.3,8H  MICRONS,.^) 

112  FORMAT  </49H  *■*■*<  WARNING  *•*■*  OPTIMAL  PF  EXPANSION  ORDER  OF 

+  22H  EXCEEDS  INPUT  IT  =  ,I3,24H.  PF  VALUES  SHOULD 

+  15HUSE0  CAUTIOUSLY/) 

113  FORMAT  <1H  // , 1 X, 40< 1 H*  ) , 3X , 3 1 HENO  OF  WAVELENGTH  CYCLE  NUMBER 
+3X,40< IH*)) 


4  FORMAT  <1H  //, 1 X, 40< 1 H* ), 3X, 38HEND  OF  RELATIVE  HUMIDITY  CYCLE 
+ER  ,  I3,3X,40<  IH^*)) 

FORMAT< IHl ,/,47H  SUMMARY  OF  RESULTS  FOR  THIS  RUN  AVERAGED  OVER 
+  12, 3 OH  WAVELENGTH< S)  ARE  AS  FOLLOWS://) 

FORMAT<1H  ,4X,48HWAVELENGTH  REL. HUMIDITY  AEROSOL  MASS 
+  nHEXTINCTI0N),/lX,29H  <  MICROMETERS )  <  PERCENT ) 

+  .6H  < GM, 25H/<SQ , CM-KM )  <PER  KM)/) 

FORMAT  <2F15.6, 1P2E16.5) 

C//13H  ***  IDSTP  =  ,I5,35H  IS  ILLEGAL.  EXECUTION 
2H*  //) 

</,  1X,23H>»'»'*  WATER  ONLY  CASE  ***/ > 

FORMAT  </,20H  EXTINCTION  COEF .  =  , 5X, 1  PEI  3 . 7, 9H  (PER 
120H  SCATTERING  COEF.  =  , 8X , 1  PE  1 3 . 7, 9H  (PER  KM),/, 

225H  BACK-SCATTERING  COEF.  =  , 3X , 1  PE  1 3 . 7 , 9H  (PER  KM),/, 

321H  ATTENUATION  COEF.  ■  , 7X , 1  PE  1 3 . 7, 1 3H  SQ-METERS/MG , / , 

428H  SINGLE  SCATTERING  ALBEDO  =  ,lPE13.7,/> 

F0RMAT<1H  ,58Hf>*>»  MORE  THAN  65  ANGLES  FOR  EOSAEL  OPTION 
♦INATEO) 

FORMAT  < 1 1(F6.2, IX)) 

FORMAT( 1H1  ) 

FORMAT(  12, 1X,2HOO, 1X,F5.2, 1X,F8.6, tX,2(E12.6, IX >) 
FORMAT(6(E12.6, IX)) 

FORMATdH  ,23Hi"***  AGAUS  WARNING  ****,/,  IX, 

*  37HTHE  ARRAY  U  IS  ASSIGNED  65  VALUES  IN  ,/,1X, 

+  43HBL0CK  DATA  WHICH  IS  LARGER  THAN  ARRAY  SIZE  ,/,1X. 

+  47HY0U  MAY  BE  CLOBBERING  INSTRUCTIONS  AND/OR  DATA,/) 

END 


1  1 
1  1  7 
118 


1  1  9 
120  FORMAT 

122  FORMAT 
123 


124 

125 

126 

127 

128 
129 


FOR  AGXCI34S0 

AGX03490 
AGXfi35  0  0 
AGX0351 r 
AGX03520 
AGX 035^0 
AGX03540 
AGX03550 
AGX 03360 
AGXCI3570 
AGX035S0 
AGX 03590 
AGX03600 
ACX0361 0 
NRAAGX03620 
AGX03630 
AGX03640 
AGX03650 
M  ICR AGX 03660 
,6,  AGX03670 
AGX 03690 
HGX03690 
AGX03700 
AGX0371 0 
AGX03720 
AGXe3730 
AGX03740 
AGX 03750 
AGX03760 
FROMAGX 03770 
AGX03780 
AGN03790 
AGX03S00 
,13,  AGX03810 
BE  ,  AGX03820 
AGX03830 
, I3,AGX03840 
AGX 03850 
NUMBAGX03860 
AGX03870 
,  AGX03880 

AGX03890 
K( , AGX 039 00 
AGX039) 0 
AGX 03920 
AGX03930 
TERMINATEDAGX 03940 
AGX03950 
AGX  03  .  ■ 

KM),/,  AGX03970 

AGX03980 
AGX03990 
AGX 04 000 
AGX0401 0 
PGM  TERMAGX04020 
AGX04030 


AGX 04 040 
AGX04050 
AGX04060 
AGX04070 
AGX04080 
AGX04090 
AGX041 00 
AGX041 1 0 
AGX04120 
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A0-Alt4  417 
UNCLASSIFIED 


ARMY  ELECTRONICS  RCSCARCN  ANO  OCVELOPI4CNT  COMMAND  RS— ETC  F/s  n/i 
PROGRAM  LISTINOS  FOR  EOSAEL  00-0  ANO  ANCILLARY  COOES  A9AUS  ANn  --ETCd 
FEB  Be  R  B  STEINHOFF 


ERADCOM/ASL-TR*0107-V2-SU 


ML 


ooo  oo  rioo  o  o  noon 


SUBROUTINE  hGXPI  < DENS , FSUM, VOL , JDIMCK > 

COMMON  /PTf/  F<513>.R<513).DR(8),RR<9>,FF<514) 

+.NRADI,PI , IDSTP,NKG,NHALV,NI 
COMMON  .^10/  lOIN,  lOUT.NUHTT,  lEO^NEOU 
DIMENSION  JDIMCKO) 

EXTERNAL  GAMMA 
WRITE  < I0UT,2) 

CHOOSE  AND  SET  UP  PARTICLE  SIZE  DISTRIBUTION  ^ 

IF  <IDSTP.NE.0>  GO  TO  < 1 2 , 1 5 , 1 b, i 7, 1 9, 1 9, 1 7 , 20, 2 1 , 22 , 24 , 26 > , IDSTP 
>  TYPE  Oi  ARBITRARY  USER-SUPPLIED  DISTRIBUTION.  NRADI  VALUES  OF 
R<J:)  and  FF<J)  MUST  BE  GIVEN,  ONE  PER  CARD,  AND  READ  IN  ORDER 
FROM  SMALLEST  RADIUS,  RLO  TO  THE  LARGEST. 

NRADI  MUST  BE  LESS  THAN  OR  EQUAL  TO  1 +2i'l.  JD I MCK<  2  > 

WRITE  < I0UT,7) 

IF  (NRADI .GT. JDIMCK<3))  CALL  DIMER<2> 

Do  9  J=1,NRADl 
9  READ  (I0IN,1)  R(J),FF<J) 

RLO=R< 1 > 

DO  10  J=1 , NRADI , 5 
JK=.J+4 

IF( JK.GT. NRADI  )JK=NRADI 
10  WRITE  < lOUT, 1 1  K R< K  ),FF< K  J, JK> 

WRITE  < lOUT, 1 1  ) 

FF(NRADI  +  1  >*=FF(NRADI  ) 

RR( 1  )=RLO 
RR(2)=R<NRADI  > 

MIN=0 
GO  TO  26 

'  TYPE  1:  LOG-NORMAL  DISTRIBUTION 

12  READ  <IOIN,1>  RBAR, SIGMA, RLO, RHI 

SIGMA  IS  STANDARD  DEVIATION,  NOT  LN<SIGMA> 

SIGIN=SIGMA 
SIGMA=ALOG<  SIGMA  ) 

A=AeS<  1  .  E0X<  2  .  SOSbRSZEO-t-SIGMA  >  ) 

IF  <<RHI-RLO),LE. 1 .E-4)  GO  TO  13 
RR< 1  )=RL0 
RR(  5  >*=RHI 
GO  TO  14 

13  RRCI  )=RBAR*EXP<-4.E0=*«SIGMA> 

RR<  3  >=RBAR*EXP<  4 . E0*SIGMA  > 

14  RR<2)-R6AR 
MIN=1 

WRITE  <I0UT,3>  RBAR, SIGIN, RLO, RHI 

AVOL  =  4 . 18879EOt‘<RBAR**3.EO  >>»EXP<4.5E0*SIGMA*SIGMA> 

HERE  AND  ELSEWHERE,  AVOL  IS  THE  VOLUME  OBTAINED  VIA 
ANALYTICAL  INTEGRATION  OVER  THE  LIMITS  RLO  =0  TO  RHI  = 

INFINITY!  THAT  CAN  ONLY  BE  DONE  FOR  A  FEW  IDSTP  CASES. 

GO  TO  28 

<  TYPE  2i  DOUBLE  EXPONENTIAL  F<  R  )=CUE*A*EXP< -A*R  >+(  1 -CUE  >t<B>*EXP< -B*R  > 

RESTRICTIONS:  RHI. GT, RLO,  B.GT.A.GE.O,  0 . LE . CUE . LE , 1 . 0 . 

15  READ  <IOIN,1)  RLO, RHI, CUE, A, B 
WRITE  <I0UT,4)  RLO, RHI, CUB, A, B 
RR< 1  )=RLO 

RR<3>"*RHI 

RR<  2  >=0 . 5E0f <  RLO+RHI  ) 

MIN*1 
GO  TO  28 

s  TYPE  3:  DEIRMENDJIAN  MODEL  C,  F< R >  -1.0,  RLO . LE . R . LE . 4*DELRD , 

F<  R  )=<  4*DELRD/R  )«t<*4,  R  .  GE  .  <  4i‘DELRD  > 

NRADI  IS  READ  IN  EARLIER  IN  THE  MAIN  PROGRAM. 

16  DENS-1 .378E+04 
DELRD-0. 02E0 
RLO-0. 02E0 

RHI-RLO+DELRD*  FLOAT< NRADI- 1 > 

RR< 1 >-RLO 
RR<3>=RHI 
MIN=1 

RR<  2  )-RL0+4 . E0*DELRD 
GO  TO  28 

<  TYPE  4  AND  TYPE  7i  POWER  LAW.  F<R>  »  CUEt-RH-n-A 


AGAOOu 1 0 
AGA00020 
AGA'i0030 
AGA00040 
AGA00050 
AGA00060 
AGA 00070 
AGACI0080 
AGA 00 090 


AGA001 40 
AGA001 60 
AGA001 70 
AGA00190 

AGA 002 00 
AGAn021 0 
AGA00220 
AGA 00230 
AGA00240 
AGA00250 
AGA00260 
AGA00270 
AGA00280 
AGA 00290 
AGA00500 
AGA 003 1 0 
ACA00320 
AGA00330 
AGA 00340 
AGA 00350 
AGA00360 
AGA 00370 
AGA 00380 
AGA 00390 
AGA 004 00 
AGA 0041 0 
AGA00420 
AGA 00430 
AGA 004 40 
AGA00450 
AGA00460 
AGA00470 
AGA 00480 
AGA 00490 
AGA 005 00 
AGA 0051 0 
ACA00520 
AGAOOSSO 
AGA00540 
AGAO05;iO 
AGA00560 
AGA 00570 
AGA 00580 
AGA00590 
AGA00600 
AGA0061 0 
AGA00620 
AGA 00630 
AGA 00640 
AGA00650 
AGA 00660 
AGA00670 
AGA006d0 
AGA00690 
AGA 007 00 
AGA0071 0 
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RLO.LE.R.LF.RHI;  VIS=V1SIBILITY  IN  KILOHETEks,  AGA00720 

IF  <IDSTP.EQ.4)  GO  TO  18  AGA00730 

TYPE  7  PRESCRIBED  PARAMETER.  AGA00740 

READ  UOIN,1>  VIS  AGA0075i 

RLO^O.IEO  AGA00760 

RHI=15.E0  AGA0077U 

CUE=30.E0  AGA00780 

p=4,Eij  AGA  0  0790 

DEH5=1 1  . E0*»<  5 . EO-ALOG ( 0<  VIS  >  >  AGAuOSOO 

TYPE  4  PRESCRIBED  PARAMETERS.  AGA00810 

IF  < IDSTP . EG . 4  i  READ  <IOIN,i>  RLO, RHI , CUE, A  AGAuuS20 

WRITE  <rOUT,5)  RLO.RHI.CUE.A.VIS  AGA00830 

RR<  1  >*RLO  AGA0CI840 

RR<3>=RHI  AGA00850 

RR<:  2  >=<  0  .  SEO*^  RLO*>*<  -  A  J+RH I  >*<>*■<:  -  A  >  '}  .E0.^A  >  AGAOuSbO 

MIN=1  AGA00870 

GO  TO  28  AGA 00880 

TYPE  5:  MODIFIED  GANMA/'GENERAL I2ED  KHIRGIAH-MAZIH  AGA00S80 

F<R)  =  <  R’O’t'ALh  )i'EXP< -ALF*<  <  R/RC  >**GAM  J/GAM  >  AGA00900 

RLO.LE.R.LE.RHI .  AGA00910 

TYPE  b!  SPECIAL  CASE  FOR  UATER  FOGS  OR  CLOUDS,  AGA00920 

IN  WHICH  CASE  ELWC  IS  LIQUID  WATER  CONTENT  AGA00930 

IN  GRAMS  PER  CUBIC  CENTIMETER:  AGA00940 

ELWC  IS  IGNORED  IF  IDSTP  =■  5.  AGA00950 

READ  <IOIN>1)  RLO.RHI,RC,ALF, GAM, ELWC  AGA009b0 

IF  <IDSTP.EQ.6)  DEHS=ELWC  AGA00970 

WRITE  <IOUT,b)  RLO, RHI ,RC, ALF, GAM  AGA009S0 

RR< 1 >=RLO  AGA00990 

RRc2>=RC  AGAOIOOO 

RR<3>=RHI  AGAD1010 

MIN=1  AGA01020 

B=ALF/'<GAMx<RC4-*GAM>  AGA01030 

AV0L=4.  lessee**! -3. /'GAM  )*GAMMA<<ALF-»-4.  VGAM  )/CAMMA<  <:  ALF+ 1  ,  >.-’GAM>  AGA01  040 
GO  TO  28  AGA01 050 

TYPES  8,9,10:  BIMODAL  LOG-NORMAL  DISTRIBUTIONS.  AGAOIObO 

METHOD  BELOW  VALID  FOR  RBARC-*EXP< -SGA  )  .  CT  .  RBARA>*EXP<  SGA  >  AGA01  070 

TYPE  8:  CONTINENTAL  BIMODAL.  AGAOIOSO 

FOA=4.E03  AGAOIOSO 

FOC=2,1EO  AGA01100 

SGA=0.74E0  AGA01110 

SGC»0.81E0  AGA01120 

R6ARA=0.03E0  AGAOt130 

RBARC=0.4E0  AGA01140 

GO  TO  23  AGA01150 

TYPE  9i  MARITIME  BIMODAL.  AGAOIlbO 

F0A*4.E02  AGA01I70 

FOC=3.8EO  AGA01180 

SGA=0.68E0  AGA01190 

3GC=0.74E0  AGAOIOOO 

R6ARA=0.05E0  AGA01210 

RBARC=0.65E0  AGA01220 

GO  TO  23  AGA01230 

TYPE  10;  URBAN  BIMODAL.  AGA01240 

FOA=2.E04  -  AGA01250 

FOC=0.6E0  AGA01260 

SGA-0.63E0  AGA01270 

SGC:a.77E0  AGA01280 

RBARAs0.04E0  AGA01290 

RBARC=0.63E0  AGA01300 

CALCULATE  RADII  FOR  TYPES  8,9,10.  AGA01310 

RR<  1  >=-RBARA*EXP<  -4  .  E0<*ABS<  SGA  >  >  AGA01  320 

RR<2>=RBARA  AGA01330 

RR<  3  >=RBARA4>EXP<  4  .  E0>»ABS<  SGA  >  )  AGA0 1 340 

RR<4  >«RBARC*EXP<-4.E0-»ABS<SGC>)  AGA01350 

RR<5  >-RBARC'«iEXP<  4  .  EOfABSC  SGC  >  )  AGA01  360 

MIN-2  AGA01370 

DO  60  J-1,4  AGA0t380 

DO  60  1-1,4  AGA01390 

IF  <RR<  1-fl  >,GT  .RR<  1  >>  GO  TO  60  AGA01400 

HH-RR<I>  AOA01410 
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Rk<  I  >**RR<  I  +  i  >  hGh0142u 

RR<I  +  i:)=HH  rtGA0t430 

CONTINUE  AGAo144u 

GO  TO  28  AGi^0145  0 

Type  1 i !  hGhOI 460 

USER  SUPPLIED  BIMODPL  CASE-.  FOA  AND  FOC  ARE  THE  NUMBER  DENSITIES  AGA01470 
FOR  THE  ACCUMULATION  <  SMALLER  RBAR>  AND  COARSE  MODES,  AGAOMSO 

RESPECTIVELY,  IN  PARTICLES  PER  CUBIC  CENTIMETER,  AGA01490 

SGA  IS  STD. DEVIATION  FOR  MODE  A  NOT  LN<SIGMA)  AGA01500 

SGC  IS  STD  .DEVIATION  FOR  MODE  C  **  NOT  LNOIGMA)  ***  AGA01510 

**+  NOTt.  HOWEVER,  THAT  SGA  AND  SGC  ARE  THE  LOGS  OF  THE  AGAOISiiO 

STANDARD  DEVIATIONS  IN  THE  PRE-CODED  CASES  TYPE  8-10.  AGA01530 

READ  <IOIN,1)  FOA, kBARA, SGA, FOC, RBARC, SGC  AGa01540 

WRITE  < I  OUT, 25)  FOA , RBARA , SGA , FOC , RBARC , SGC  AGA0155  0 

SGA=ABS< ALOGCSGA))  AGA0t560 

SGC=aBS<  AL0G<  SGC  )  >  AGAOi 57  0 

GO  TO  2j  AGhOISSO 

TYPE  12:  MARSHALL-PALMER  RAIN  MODEL.  AGAOI 5S0 

C.F.  MASON,  PHYSICS  OF  CLOUDS,  CH .  OH  RADAR  METEuKuLOGY.  AGAOI 600 

INPUT  PARAMETER  RAIN  IS  RAIN  RATE  IN  MILL IMETERSrHOUR :  AGA01610 

f’*  EMA,CAYA,  AND  RHOA  ARE  REQUIRED  FOR  THIS  DISTRIBUTION.  AGA0I620 

READ  <IOIN,1)  RAIN  AGA01630 

ENZERO=0 . 08E0  AGA01640 

CAPL=41  ,E0*RAIN>**<-0.21E0)  AGAOI  65  0 

DENS=ENZ£RO/'CAPL  AGAOi  66  0 

AVOL=PI*<CAPL**<-3.EO))*1 .Ei2  AGA01670 

CONVERT  UNITS  FROM  CM-4  TO  < CM-3 >♦< HICROMETERS»*< - 1  i  > :  AGAOiSSO 

THE  FACTOR  OF  2  CONVERTS  THE  M-P  FORMULA  FROM  DIAMETER-DATA  TO  AGA0(690 
RADIUS  BASED  FORM.  AGAOi 700 

ENZER0=2.E-4*ENZER0  AGAOi 710 

CAPL=2 . E-4*CAPL  AGAOi 720 

MIN=0  AGa01730 

RR':i)=l.E-4  AGAOI  740 

RR<2)*2500,E0  AGA01750 

WRITE  <I0UT,27>  RAIN, DENS  AGA01760 

THE  NEXT  BLOCK  IS  COMMON  TO  ALL  DISTRIBUTIONS.  AGAOI 770 

IT  SETS  THE  NMAX  VALUES  OF  RADIUS,  R<KK>.  AGAOI 780 

MAX=*J0IMCK<2)  AGA01790 

NHALVsMAX-MlN  AGAOiBOO 

NMAX=1  •*'2:*>*MAX  AGA01810 

NI=2r:*i*NIN  AGA01620 

IF  <NMAX.GT. JDIMCK<3).0R,NI .CT. JDIMCK<3>>  CALL  DIMER<3>  AGA01830 

NLAST=NI+1  AGA01840 

NKG=2'**NHALV  AGAOI  850 

ENKO=  FLOAT<NKG>  AGA01860 

IF  < IDSTP.EQ. 0)  GO  TO  30 

DO  29  1=1 ,NI  AGA01870 

DR< I >»RR< 1+1 >-RR< I >  AUC01880 

DO  29  K*1,NKG  AGA01890 

KK=< 1-1  )*NKG+K  AGA01900 

R'CKk  )=RR<  I  )+<  FLOAT<K-1  >)+DR<  I  >/ENKG  AGAOI  910 

R<HMAX)=RR<NLAST)  AGAOI 920 

BRANCH  AGAIN  CALCULATE  THE  DIFFERENT  F< R )  ON  THE  NMAX  POINTS  R< K >  AGA01930 
GO  TO  <31 ,33,35,38,41 ,41 ,39,43,43,43, 43,46 >, IDSTP  AGA01940 
TYPE  Oi  ARBITRARY  AGAOI 950 

INTERPOLATE  TO  EQUAL  INCREMENTS  OVER  RADII 

DELR=<R<NRADI  >-RLO  >/’ENKG  AGAOI  960 

F<  1  >-FF<  1  > 

NMAXM1=NMAX-1 
DO  64  KK=1,NMAXM1 
RAOUS»RLO+DELR'*FLOAT<KK  ) 

DO  62  J-1,NRADI 
K  =  J 

IF  <R< J>.CE.RADUS>  GO  TO  61 

CONTINUE 

CONTINUE 

F<KK+1 >=<RADUS-R<K-1 > >*< FF< K >-FF< K-1  >)/ 

I  <R<K>-R<k-1  )>+FF<K-1  ) 

CONTINUE 

DO  65  1-1 ,N1  AGA01870 
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L)R<  I  >=RR<;  1  +  1  >-RR<  I  > 

DO  65  K«f,NKG 
KK=( 1-1 >fNKG+K 

R';KK  )=RR-:  I  >+<  FL0RT<K-1  :>>*DR<  I  )/'ENKG 
K<  HMhX  )=RR^  HLhST  i 
GO  TO  48 

TYPE  1 !  LOG  NORMAL 
DEN=2 .  E0=*S1GMA*SIGHh 
DO  32  KK=ijNMAX 
GNUM*ftLOG<  R<  KK  )/'RBAR  > 

F<  KK  >=EXP<  -GNUrt*GNuM/’DEN  ■j>«‘A/'R<  KK  > 

GO  TO  48 

Type  2:  DOUBLE  EXPONENTIAL 
DO  34  KK=1.NMAX 

FKK=<  1  .  EO-CUE  )*Bt.EXP<  -B‘»R<  KK  )  > 
p.;  kK  .)=FKK+CUE+p*EXP<  -A+R<  KK  >  > 

GO  TO  48 

TYPE  3:  DEIRMENDJIAN  MODEL  C. 

DO  36  KK=1.NMAX 

F<KK>=1  .EO 

NKG1=HKG+1 

DO  37  KK=NKG1,NMAX 

FC  KK  >=<  RR<  2  VR<  KK  )  )>»»4  .  EO 

GO  TO  48 

TYPES  4  AND  7 \  POWER  LAW 

GO  TO  39 

DO  40  KK=1,NMAX 

F<  KK  )=CUE  +  R<  KK  >■*■*<  -A  ) 

GO  lO  48 

TYPE  5  AND  TYPE  6:  MODIFIED  GAMMA 
DO  42  KK=1,NMAX 

F<  KK  )=<  EXP<  -B*R<  KK  )<4it<GAM  )  >*R<  KK  >**ALF 
GO  TO  48 

TYPES  8>9, 10.11:  BIMODAL  LOG-NORMAL  DISTRIBUTIONS 

DENA=2.E0«SCA>*'SGA 

DENC=2.E0*SGC%SGC 

PAA^FOAXSCA 

FCC-FOC/SCC 

DO  44  KK«1.NHAX 

GNUMA<:ALOC<  R<  KK  >7RBARA  > 

GNUMC-ALOG<  R<  KK  >/RBARC  ) 

FA=FAA*EXP<  -GNUMA^GNUMA.-’DENA  > 

FC^FCC*EXP< -GNUMC^GNUMCXDENC  > 

F<  kK  >=<  FA+FC  )XR<  KK  > 

DEHS-FOA+FOC 
WRITE  < I0UT.45)  DENS 

V0LA=4 . 1  8879E0'*<  RBARA>**3  .  EO  )*EXP<  4 . 5EO>*SGA*SGA  >>*FOA 
VOLC-4 , 1  8879E0*<  ReARC'»*3  .  EO  )*EXP<  4 . 5E0*SGC*SGC  >>*-FOC 
AVOL=<  VOLA+VOLC )7DENS 
CO  TO  48 

TYPE  12:  MARSHALL-PALMER  RAIN  MODEL 

DO  47  KK»1,NMAX 

F<  KK  )=ENZERO*EXP< -CAPL*R<  KK ) ) 

CALCULATE  NORMALIZED  F< KK )  AND  SOME  DRV  VOLUMES  USING  ALL  NMAX 
VALUES  OF  RADII. 

<VOL=AVERAGE  PARTICLE  VOLUME  IN  A  DISTRIBUTION >.  THE 
NORMALIZATION  AND  FURTHER  VOLUMES  ARE  RECALCULATED  LATER 
BY  THE  HALVING  INTEGRATION  METHOD. 

FSUM=0,E0 

IF<F< 1  ).LT. 0,E0)F< I >-0. OEO 

DO  49  J-2,HMAX 

1F<F<  J),LT. 0,E0)F<  0)-0.E0 

FSUMxFSUM+0.5E0'»<F<  J>+F<  J-1  >)*<R<  J)-R<  J-1  >> 

DO  50  Jxl.NMAX 
F<  J)-F<  J>/FSUM 
WRITE  <I0UT,8)  FSUM 
NR AD I  xNMAX 

IF  < IDSTP.EQ. 1 .OR. I0STP.EQ.5.0R, 1DSTP.CE.8>  WRITE  <10UT,51)  AVOL 

VOL-O.EO 

DO  52  Jx2.NMAX 


AGA01 880 
ACA01890 
AGA01900 
AGAOl  ■-..1  0 
AGA0192C 
AGA0201 0 
AGA02u20 
AGA02030 
AGA02u4u 
AGA02050 
AGAu20bCi 
AGACi2070 
AGA02080 
AGA02090 
AG A  021 0  0 
AGA021 1 0 
AGA021 20 
AGA02130 
AGA021 40 
AGA02150 
AGA021 60 
AGA02170 
AGA021S0 
AG A 021 90 
AGA02200 
AGAD221 0 
AGA02220 
AGA02230 
AGA02240 
AG A 02250 
AGA02260 
AGA02270 
AGA 02280 
AGA02290 
ACA02300 
AGA0231 0 
AGA02320 
AGAG2330 
AGA02340 
AGA0235C 
AGA 02360 
AGA02370 
AGA02380 
AGA02390 
AGA 024 00 
AGA 0241 0 
AGA 02420 
AGF'''243  0 
AGAli^440 
AGA 02450 
AGA02460 
AGA 02470 
AGA 02480 
AGA02490 
AGA 025 00 
AGA025I 0 
AGA02520 
AGA02530 
AGA 02540 
AGA02S50 
AGA02560 
AGA02570 
AGA02580 
AGA02590 
AGA02600 
AGA0261 0 
AGA02620 
AGA02630 
AGA02640 
AGA 026 50 
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52  V0L=V0L+2 . 0944E0>f<  F<  J  J  t**!  ,  EO+F<  j-1  i*R<  J- 1  >«*3  .  EO  >*<  R<  J  >-ft<  J-  huh 02660 

1  t>>  AuH 02670 

WRITE  <IuUT,53>  VOL  hGh026SO 

THE  VOLUME  PER  PARTICLE  CALCULATED  HERE  IS  OBTAINED  USING  AGA02690 

ALL  AVAILABLE  C NMAX  VALUES)  VALUES  FOR  THE  PARTICLE  RADII.  AGA02700 

WRITE  < lOUT, 54 >  AGA02710 

DO  56  INT=1,N1  AGA02720 

INF*INT+1  AGA02730 

56  WRITE  <I0UT,55)  INT, RR< IHT >. RR< INF )  AGA02740 

1  FORMAT  <6E12.6.I3)  AGA02750 

2  FORMAT  <1H  , 7/24H  AEROSOL  PARAMETERS  ARE  >  AGA02760 

3  FORMAT  <1H  ,24X>6HRBAR-  , E 1 2 . 6 , 5X , 7HSI GMA=  ,E12.6,7H  RLO  »  , E 1 2 , 6 , AGA 0277 0 

+  7H  RHI  =  ,E12.6/’)  AGA02780 

4  FORMAT  <1H  ,24X.5HRL0“  , E 1 0 . 4 , 1 X , 5HRHI =  , E 1 0 . 4 . 1 X , 5HCUE=  ,E10.4,  AGA02790 

+  1X,3HA=  ,E1 0.4, 1X,3HB=  ,E10.4/>  AGA02800 

5  FORMAT  <1H  ,24X,5HRL0=  , E 1 0 . 4 , 1 X, 5HRH1 =  , E 1 0 . 4 , 1 X , 5HCUE=  ,E10.4,  AGA0281 0 

+  1X,3HA=  ,E10.4,1X,4HVIS=,E10.4/)  AGA02820 

6  FORMAT  <1H  ,24X,5HRL0»  , E 1 0 . 4 , 1 X, 5HRHI =  , E 1 0 . 4, 1 X , 4HRC«  , El  0 , 4, 1 X, AGA02830 

+  5HALF=  ,E1 0.4, 1X,5HGAM=  ,E10.4/>  AGA02840 

7  FORMAT  <X1H  , 5< 26H  RADIUS  RELATIVE  NO.  >77)  AGA02850 

8  FORMAT  <746H  NORMALIZATION  FACTOR  FOR  SIZE  DISTRIBUTION  =  ,E14.7>  AGA02860 

n  FORMAT  < IX, 1 0< 1PE12.6, 1X>)  AGA02870 

25  FORMAT  <7tX,7HN<A)  =  ,Ef2.6,2X,9H  RBARA  =  , E 1 2 . 6 , 2X, 1 2H  S1GMA<A)  =AGA02880 

+  ,E12.6,/, 1X,7HN<C)  =  ,E12.6,2X,9H  RBARC  =  ,E12.6,2X,  AGA02890 

-*■  12H  SIGMACC)  =  ,E12.6.^;)  AGA02900 

27  FORMAT  <71X,42H  MARSHALL-PALMER  RAIN  MODEL  :  RAIN  RATE  =  , 1  PE  1 0 . 3, AGA 029 1  0 
+  21H  MM  PER  HOUR,  DENS  =  ,1PEt2.6,8H  PART/CO  AGA02920 

45  FORMAT  <7,1H  ,50H**-*  BIMODAL  DISTRIBUTION ...  EQUIVALENT  DENSITY  ISAGA02930 
+  ,1PE13.6,18H  PARTICLES  PER  CC,7>  AGA02940 

5t  F0RMAT<745H  AVERAGE  ANALYTIC  DRY  VOLUME  PER  PARTICLE  IS  ,3X,  AGA02950 

♦  1PE12.6,18H  CUBIC  MICROMETERS)  AGA02960 

53  FORMAT  < 1 X, 47HAVERAGE  NUMERICAL  DRY  VOLUME  IS  ,  AGA02970 

+  1PE12.6,18H  CUBIC  MICROMETERS/ >  AGA02980 

54  FORMAT  <1X,10X,35H  SIZE-INTERVALS  USED  ARE  AS  FOLLOWS/)  AGA02990 

55  FORMAT  <1H  , 1 4H  INTERVAL  NO.  , 13, 5X, 7HRM1N  =  ,Fn.5,5X,8H  RMAX  =  AGA03000 

♦  ,F11.5)  AGA03010 

RETURN  AGA03020 

END  AGA03030 
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SUBROUT  I NE  AGXP2<  RELHUM , CT3UH , C3SUM , CR3UM , TVOL , TMRSS , DENS , CATTN , 

1  TEMP, DELTA, NINDX, lU , OLSTAR , 0M2 , ULUL , IT , WAVE , EM , CAY , EMM ,  MQRTE , 

2  PFN2R0) 

REAL  KEXT,KEXTT,KEXOLD 

H,B.  FFF  IS  AN  ALIS  FOR  ARRAY  FF 

COMMON  /PT1/  F<513  >,R<513i,DR<8),RR<9>,FFF<514  ), 

+NRADI,P1, IDSTP,NKG,NHALV,H1 

COMMON  /PT2X  PHH<65),PSUMTT<65>,PGG<65>,PSUM<65>,PSUMT<65>, 
1P<65) 

COMMON  /lO/  10IN,I0UT,NUNIT,IE0,NE0U 
COMMON  /PGXM/  C< 65  ), W< 65  ) , OLT< 65 >, JDlMCKt 3 > 

IN  THIS  SUBROUTINE  THE  FOLLOWING  CONVENTIONS  ARE  USED  IN 
PREFIXING  VARIABLE  NAMES: 


THE  LETTER  C  IS  USED  FOR  CROSS-SECTIONS 

THE  LETTER  Q  IS  USED  FOR  EFFICIENCY  FACTORS 

THE  LETTER  X  IS  USED  FOR  EXTINCTION  COEF .  PER  UNIT  PATH  <KM> 

THE  LETTER  T  IS  A  SUFFIX  FOR  TOTAL  VALUES 

THE  LETTER  0  IS  A  PREFIX  FOR  OMEGA  SUB  1  AND  2  CALCULATIONS 

FOR  THE  IDSTP=6  AND  12  CASES,  DENS  IS  USED  TO  TRANSFER  THE 
LIQUID  WATER  CONTENT  FROM  THE  MAIN  PROGRAM  TO  THIS  SUBROUTINE: 
ELWC  IS  USED  AS  THE  AEROSOL  CONCENTRATION  FOR  THOSE  CASES. 

IF  < IDSTP.EQ.6.0R. IDSTP.EQ. 12)  ELWC=DEHS 
P2RSMT*0. 

OLSTAR-0 . OEO 
OM2=O.EO 
CTSUMT=0. OE+00 
CSSUMT=0. OE+OO 
DENST=0.E0 
CRSUMT-0. OE+00 
EMM=1 .EO 
NLINES=0 
BH=1 . 056E-3 

FACTORS  BH  AND  CH  ARE  USED  IN  SI2E  ADJUSTMENTS 
FH  IS  THE  SATURATION  RATIO 
FH^RELNUM/I OO.Eu 
CH=FH/’<  1  .EO-FH) 

CONCT=*0.  OEO 
KEXTT=0.E0 

CONVERT  VOL  PER  PARTICLE  RECEIVED  FROM  MAIN  PROGRAM  VIA  VARIABLE 

TVOL  TO  DRY  VOLUME  PER  PARTICLE  IN  CUBIC  CENTIMETERS 

DRYVOL=TVOL*l . OE-12 

TVOL=0,E0 

TMASS=0.E0 

DO  6  J=1 , IT 

PSUMTT<  J)«0, OEO 

PHH<  J>bO. OEO 

PGG<  J)=0.E0 

CONVERT  TEMP.  TO  KELVIN  FOR  SUBROUTINE  WATER  USAGE 
TEMK=TEMP+273. 16E0 

SKIP  SUBROUTINE  WATER  FOR  THE  IDSTP  =  12  CASE,  AND  READ  THE 
OPTICAL  DATA  FOR  RAIN  AS  EMUA, CAYA, ETC .. .NEEDED  BECAUSE  CASE 
IDSTP=12  MAY  BE  AT  WAVELENGTHS  LONGER  THAN  FOUND  IN  ROUTINE 
WATER . 

IF  < IDSTP.EQ. 12)  GO  TO  8 

SUBROUTINE  WATER  RETURNS  INTERPOLATED  VALUES  FOR  EMW,  CAYW  AND 
RHOW  AT  WAVELENGTH  ■  WAVE  AND  AT  TEMPERATURE  =  TEMK  <DEG  K). 

EMW  IS  REAL  PART  OF  INDEX  OF  REFR  FOR  PURE  WATER  AT  TEMP<DEG  C>. 
CAYW  IS  IMAG.  PART  OF  INDEX  OF  REFR.  FOR  PURE  WATER: 

CAYW,  HERE  IS  POSITIVE,  BUT  TREATED  AS  NEGATIVE  IN  MIE-ROUTINE. 
RHOW  IS  MASS  DENSITV<GM/'CC )  AT  TEMPERATURE  ■  TEMP  <  DEG  C). 

CALL  WATERS  WAVE, EMW, CAYW, TEMK, RHOW  > 

WRITE  < I OUT, 9)  EMW, CAYW, TEMP, RHOW 
BEGIN  LOOP  OVER  AEROSOL  COMPONENTS  INDEXED  BY  NK 
8  DO  32  NK-I.NINDX 

BYPASS  READ  OF  EMA , CAYA, ETC .  FOR  IDSTP<-6  CASE.. USE  WATER  DATA 

IF  < IDSTP, NE. 6)  GO  TO  10 

EMA=EMW 

CAYA-CAYW 

RHOA-RHOW 

CONC-ELWC 


AGBOOOl 0 
AGB00020 
AGB00030 
AGBOCiO*?  j 
AGB00050 
ACB00060 
AGB00070 
AGB00080 
AGB00090 
AGB001 00 
AGB001 1 0 
AGB00120 
AGB00130 
AGB00140 
AGB00150 
AG600160 
AGBOOl 70 
AGB00180 
AGBOOl 90 
AGB00200 
AGB0021 0 
AGB 00220 
AGB00230 
AGB00240 
AGB00250 
AGB00260 
AGB 00270 
AGB 00280 
AG600290 
AGB00300 
AGB0031 0 
AGB 00320 
AGB00330 
AGB00340 
AGB00350 
AGB00360 
AGB00370 
AGB00380 
AGB00390 
AG600400 
AGB004 1  0 
AGB0D420 
AGB00430 
AGB00440 
AGB00450 
AGB00460 
AGB00470 
AGB00480 

agbl  :<‘9o 

AGB 005 00 
AGB 0051 0 
AGB00S20 
AGB00530 
AG600540 
AGB00550 
AGB00560 
AGB 00570 
AGG00580 
AGB00590 
AG600600 
AGB0061 0 
AGB00620 
AGB00630 
AGB 00640 
AGB00650 
AGB00660 
AGB00670 
AGB006S0 
AG600690 
AC600700 
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ErtUH=O.OEO  hGB0  0?1u 

GO  TO  11  AGB0  07«;0 

♦  REhD  optical  and  physical  data  AGl  .'0/3u 

10  READ  <I0IN,2>  EMA, CAVA, EMUA , RHOA, CONC  AGB 00740 

IF  <IU.EQ.O)  EMA=EMW  AGB 00750 

IF  <  IW. EQ.O)  CAYA=CAYUI  AGB00760 

IF<  IDSTP  ,  NE  .  1  2  )  GO  TO  11  AGBu07.'0 

EMUA=O.OEO  AGB007S0 

kHuw=RHOA  AGBOOi'SO 

EMU=EMA  AGB 003 00 

CAYw=CAVA  AGBOOBjO 

11  IF  <kHOA.LE.O,EO>  RHOA-1.EO  AGB00820 

WRITE  <10Ln,3>  NK> EMA, CAVA, RHOA, EMUA> CONC  AGB00830 

IF_<EMA,LT. 1 .E-30)  GO  TO  44  AGB00340 

BH  1  =BH>»<  298  .  EO^TEMK  ;  AGB00830 

IF  < EMUA . LE , 0 , 01 >  CH=0,0  AGBOOSeO 

BC=BHT*CH  AGB00870 

A=1  .EO+<<RHOA/'RHOW>*EMUAi>CH>  AGBOOSSO 

AC=A>t'*<  1  .  E073  .  Eu  >  AGB 0089  0 

ADJUST  EM,RHO  AND  CAY  PER  G.  HANEL/ADVANCES  IN  GEOPHYS.-'1 976  AGBOOSOO 

RH0=RH0W+<RH0A-RH0W)7A  AGB0091 0 

EM=EMW+<EMA-EMW  >7A  AGB 0  092  0 

CAY=CAYW+<  CAYA-CAYU  )/A  AGB00930 

CAY=CAY/’EM  AGB  0  094  0 

INITIALIZE  QUANTITIES  USED  TO  HOLD  RUNNING  SUMMATIONS  OVER  AGB00950 

RADII  FOR  THE  CURRENT  COMPONENT  AGB00960 

CTSUM=0,E0  AGB00970 

C33UM=0.E0  AGBOOSSO 

CR5UM=0.0E0  AGB00990 

VOL=0,0E0  AGB 01 000 

OL1SuM=O.OEO  AGB01010 

OL2SUM=O.EO  AGB 01 020 

PZRSUM=0.  AGB01030 

DO  13  J=1,1T  AGB01040 

13  PSUM< J)=0. OEO  AGB01050 

PRINT  HEADER  IF  DETAILED  MIE  RESULTS  ARE  TO  BE  PRINTED  AGB01060 

IF  <MQRTE.£Q. i2345>  WRITE  <IOUT,S>  AGB01070 

BEGIN  ACTUAL  LOOP  OVER  RADIUS  INTERVALS  FOR  THE  CURRENT  NK  VALUE  AGB01080 

THIS  LOOP  IS  THE  ONE  IN  WHICH  THE  MIE  CALCULATIONS  ARE  CALLED  AGB01C90 

INTERVALS  ARE  INDEXED  BY  1.  THERE  ARE  NI  SUCH  INTERVALS.  AGBOIIOO 

DO  26  l^^l ,  NI  AGB01  1  1  0 

NR.ADI=2  AGB01120 

D=Rk< 1+1 >-RR< I >  AGB01130 

RIT  IS  THE  ADJUSTED  RADIUS  FOR  THE  RELATIVE  HUMIDITY  TO  BE  USED  AGB01140 
IN  THIS  PARTICULAR  RUN  OR  PASS  AGB01150 

RIT=RR<  1  >i'AC  -<BCXAC)  AGB01160 

IF  (RIT.LT.RR<I).OR.RR<n.LT.0.04E0)  RIT-RRCI)  AGB01170 

ALPHA=2.E0*PI*RIT.''WAVE  AcC  01180 

ROUTINE  MIEGvX  DOES  THE  ACTUAL  MIE  CALCULATIONS,  AG&0119U 

NOTE  THAT  THE  IMAG.  PART  OF  THE  REFRACTIVE  INDEX  <CAY>  HAS  BEEN  AGB01200 
NORMALIZED  THROUGH  DIVISION  BY  THE  REAL  PART  < EM >  BEFORE  ITS  AGB01210 

VALUE  IS  PASSED  TO  THE  MIE-ROUTINE.  AGB01220 

MIEGX  RETURNS  THE  EXTINCTION  EFFICIENCY  FACTOR  AS  QT  AGB0123U 

MIEGX  RETURNS  THE  SCATTERING  EFFICIENCY  FACTOR  AS  QS  AGB01240 

MIEGX  RETURNS  TNE  BACK-SCATTERING  < RADAR >  EFFIC.  FACTOR  AS  OR  AGb01250 

MIEGX  RETURNS  THE  AVERAGE  INTENSITY  <I1*J2>/2  IN  THE  ARRAY  P<  >  AGB01260 

AT  ANGLES  =  ARCCOS<  C<  )  ), WHERE  C<  )  IS  SET-UP  BY  AGB01270 

SUBROUTINE  GUSET  OR  ANGLE  AGB01280 

MIEGX  ALSO  RETURNS  THE  2-ND  AND  3-RD  LEGENDRE  EXPANSION  COEF.  AGB0129C( 

< OMEGA  SUB  1  AND  OMEGA  SUB  2>  AS  01STAR  AND  02STAR .  AGB01300 

EMO=  <EM)  AGB0131 0 

CAYD=  <CAY)  AGB01320 

ALPHAOs  < ALPHA  )  AG601330 

CALL  MIEGX<EMD,CAYD,ALPHAD,QTD,QSD,QRD,P,01STRD,02STRD,  AGB01340 

+C, IT,PFNZRO>  AGB01350 

EM=<EMD>  AGBC1360 

CAY=<CAYD)  AGB01370 

ALPHA=<ALPHAD>  AGB01380 

OT-<QTD>  AUB01390 

QS=<QSD>  AGB01400 
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04E0  >  RIT=RRt  I  +  O 


QR=<  QRD  > 

01STRR=<01STRD ) 

02SThR=<  02STRD  > 

KK=1+<  1-1  >*NK'G 

IF  <MQRTE.EQ. 12345)  WRITE  <I0UT,4>  RIT. RR< I  ), F< Kk  ), hLPHR, uT , QS, QR 
FKK=F<  KK  ) 

FkKP=FKk=»PI*RITt»»2  .EO 

V0LNH=4 . 1 888*FKk*RiT**3  .  EO 

OLl HH=01 STHR*FKkR*uT 

0L2HH»02STHR*FKkR*QT 

CTHH=QTt‘FKi<H 

CSHH=QS''‘FkKA 

CRHH=QR*FkkH 

DO  14  J=1 , IT 

PHH<  J  )=P<  J  )>fFKK 

14  CONTINUE 
PFHZER*PFNZRO*FKK 
RIT=RR<I  +  1  )*Ri::-<BC,'’AC) 

IF  <  RI  I  .  LT  .  RR'i  i  +  1  ) .  OR  .  RR<  1  +  1  )  .  LT  .  0 
hLPHA=2.E0*PI*RIT/WAVE 
EMD=  < Eh > 

ChYD=  <CRY) 

Hi PHRD=  (ALPHh) 

ChLL  MIEGXCEMD,CAVD, ALPHRD,QTD,QSD,QRD,P,01STRD,02STRD, 

+C, IT,PFNZRO> 

EM=<  EMD) 

C8Y=<  CrtYD ) 

8LPHA-< ALPHRD) 

QT=<QTD) 

Q3=<QSD> 

QR==<QRD> 

01STAR-<01STRD> 

02STAR«=<02STRD) 

KK1  =  1+NKG>*<I 
^  sp(  t  ) 

IF  <MQRTE.EQ. 12345)  WRITE  <I0UT,4>  RIT, RR< 1+ 1 >, FKK 1 , ALPHA 
FKK1AaFKK1>*PI*RIT*^2.E0 

VOLHH*<  VOLHH+4 . 1  8eE0-»FKK1  *RITf>*3  .  EO  )>*D'*0 . 5E0 
OL 1  HH=<  OL 1  HH+FKK 1  A*eT*0 1  STAR  0 . 5E  0 

0L2HH=<  0L2HH+FKK- 1  A>+QT*02STAR  ):+D* 0 . 5E0 
CTHH=<  CTHH+QTfFKKI A )*0» . 5E0 
CSHH»<  CSHH+QS*FKK 1 A  >*0* , 5E0 
CRHH=<  CRHH+QR*FKK1  A  )*D<* ,  5E0 
DO  15  J=1,1T 

PHH<  0  )-<  PHH<  J )+P<  J )*FKK 1 J^D*  0 . 5E  0 

15  CONTINUE 

PFNZER-<  PFN2ER+PFNZR0>»FKK1  >>»D*0 , 5 
FF»0.5E0*D*<FKK+FKK1 ) 

NT»:1 
N=t 

16  NJ=NT 
NT=2fNT 
D*0 .  SEOi-D 
VOLGG=0. OEO 
GL1GG»0. OEO 
OL2GG=0,E0 
CTGG*0,E0 
CSGG-O.EO 
CRGGsO.EO 
FT-O.EO 
DO  17  J-1,IT 

17  PGG':J)=0,E0 
PZRTMP*0. 

C  NEXT  LOOP  HANDLES  INTERNEDIATE  PARTICLE 
C  RMIN  AND  RMAX  FOR  THE  CURRENT  INTERVAL 
DO  19  JG-1,Nv1 

KK=1+<  1-1  )-*NKC+<2*JG-1  JOCNKC/NT) 

RIT-R<KK>*AC  -<BC/'AC> 

IF  <RIT.LT.R<KK>.OR.R<KK).LT,0.04EO>  RIT-R<KK> 
ALPHAbZ.EO+PI^RIT/WAVE 


SIZES.. THOSE  LYING  BETWEEN 
WHOSE  INDEX  IS  I . 


AGB0141 0 
AGB01 420 
AGB01 430 
AG8C 1 41 j 
AGBui 440 
AGB01460 
AGb01470 
AGB01 4S0 
AGB01 490 
AGB01 500 
AGBu1 51 0 
AGB01 520 
AGB01530 
AGB01 540 
AGB01550 
AGB01 560 
AGBOl 570 
AGB01 580 
AGBOl s90 
AGB  016  0  0 
AGBOl 61 0 
AGB 01 620 
AGBOl 630 
AGBOl 640 
AGB01650 
AGB01660 
AGBOl 670 
AGB01630 
AGBOl 690 
AGB01700 
AGBOl 71 0 
AGB01720 
AGBOl 730 
AGB01740 
AGBOl 750 
,QT,C!S,QRAGB01760 
AGB01770 
AGB01780 
AGBOl 790 
AGB01800 
AGBOl 81 0 
AGB01820 
AGB01d30 
AGB 01 840 
AGB01850 
AGBOl 860 
AGB01870 
AGB01880 
AGB0i>.:0 
AGB01900 
AGBOl 91 0 
AGB 01 920 
AGB01930 
AGB01940 
AGB01950 
AG601960 
AGB01970 
AGB019d0 
AGB01990 
AGB02000 
AG60201 0 
AGB02020 
AGB02030 
AGB02040 
AGB02050 
AGB02060 
AGB02070 
AG602080 
AG602090 
AG6021 00 
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ErtD=  < EM > 

C«YD=  <ChV> 
hLPHhD=  (ALPHA; 

CALL  MIEGX<EMD,CAYD, ALPHAD,QTD,QSD,QRD,P,01STRCS02STRD, 

-t-C,  IT,PFN2R0; 

EM  =  <Et1D; 

CAY=( CAYD  > 

ALPHA=( ALPHAD  > 

QT=( QTD  > 

QS=( QSD ; 

Qk=<  QRD ; 

01 STAR=<  01 STRD  > 

025TAR=<  02STRD ) 

IF  (MQRTE.EQ.  12345)  WRITE  <I0tJT.4)  RIT,  R<  KK  ),  F<  KK  ),  ALPHA ,  QT ,  QS .  QR 

NRADI=NRADI+1 

FKK=F( KK  ) 

FKKA=FK»PI*RIT**2  .  EO 
V0LGG=4 . 1888E0*FKK*RIT**3. OEO+VOLGG 
OL 1  GG=0L1  GG+01  5TAR+^Kk■A•CiT 
OL2GG=0L2GG+O2STAR*FKi<A'*QT 
CTGG=CTGG+QT*Fi<i<A 
CSGG  =  CSGG+GS*>-KkA 
CRGG=CRGG+QR‘fFKk:A 
DO  18  J= 1 , I  I 
PGG'.  >=PGG<  J  )+P<  J  )+FKK 
18  COHTINUE 

PZRTMP=PZRTMP+PFH2R0*Fi(K 

19  FT=FT+FKK 

C  ADD  RESULTS  ACCUMULATED  OURIHG  PREVIOUS  HALVINGS  TO  THOSE  FOUND 

C  FOR  THE  NEW  RADII  TREATED  WITHIN  THE  LOOP  OVER  INDEX  JG 

VOLHHT=0 .  SEOwVOLHH+D’t'VOLGG 
OL 1 HHT=0 . 5E  0*OL 1 HH+0*0L  1  GG 
OL2HHT=0 . 5EO*OL2HH+D*OL2GG 
CTHHT=0 . SEO'fcCTHH+D^CTGG 
CSHHT=0 . 5E  0*CSHH+0>*CSGG 
CRHHT=0 . 5E  O-fCRHH+D^CRGG 
DO  20  J*1,IT 

20  PHH<  J)>=.5E0*PHH<  J)+D-<<PGG<  J) 

PFH2ER= .  5E0*PFN2ER+D>*«P2RTMP 
FFT=O.SEO*FF+D*FT 

IF  (CTHHT.LT. 1 .E-30>  GO  TO  22 
DEL=ABS<  VOLHHT-VOLHH )XABS<  VOLHHT ) 

IF  < DEL. LE. DELTA)  GO  TO  21 
GO  TO  22 

21  IF  <N.GT.2)  GO  TO  24 

C  DO  NOT  ALLOW  DEL  LESS  THAN  DELTA  EXIT  UNLESS  AT  LEAST  TWO 
C  HAVINGS  HAVE  BEEN  DONE 

22  IF  (N.Eu.NHALV)  GO  TO  24 

C  MUST  EXIT  WHEN  NHALV  HALVINGS  HAVE  BEEN  DONE  EVEN  IF  THE  DELTA 

C  CRITERION  HAS  NOT  BEEN  SATISF lED .. SINCE  NO  MORE  VALUES  OF  RADII 

C  ARE  AVAILABLE. 

FF=FFT 
CRHH=CRHHT 
0L1HH=0L1HHT 
0L2HH=0L2HHT 
C5HH=CSHHT 
CTHH=CTHHT 
VOLHH-VOLHHT 
N=N+1 
GO  TO  16 
24  COHTINUE 

IFtN.EQ. NHALV) 

C  SUM  QUANTITIES 

CTSUM=CTSUM+CTHHT 
C3SUN-C3SUM+CSHHT 
CRSUM*CRSUM+CRHHT 
VOL=VOL+VOLHHT 
OL 1 SUM=OL 1 SUM+OL 1 HHT 
0L2SUN=0L2SUM+0L2HHT 

C  AT  THIS  POINT,  PSUM<  >  IS  THE  RUNNING  SOM  OF  THE  AVC .  INTENSITY 


WRITE<I0UT,124>  I 
OVER  ALL  INTERVALS 


TREATED  UP  UNTIL  NOW 


AG&  02 1 1 0 
AG&021 20 
AGt  j2i 30 
AGB  02140 
AGB021 50 
AGB021 60 
AGB  02  1  7  (i 
AGB 021 80 
AGB 02 1 90 
AGB  022  0  0 
AGB0221 0 
AGB02220 
AGB02230 
AGB 02240 
AGB  0225  0 
AGB022P  0 
AGB  022.'  u 
AGB 02280 
AGB 02290 
AGB 023 00 
AGB02^1 0 
AGB 02^20 
AGB02j30 
AGB 0234  0 
AGB02350 
AGB 02360 
AGB 02370 
AGB02.;8  0 
AGB 02390 
AGB 024 00 
AQB024 1 0 
AGB 024 20 
AGB02430 
AGB02440 
AGB02450 
AGB  0246  (I 
AGB02470 
AG802480 
AGB0249U 
AGB 025 00 
AGB 025 1 0 
AGB 02520 
AGB 02530 
AGB 02540 
AGB02550 
AGBC2560 
AGB 02570 
A..’:  0258  0 
AGB02:>90 
AGB02600 
AGB 0261 0 
AGB 02620 
AGB 02630 
AGB 02640 
AGB02650 
AGB 02660 
AGB02670 
ACB02630 
AGB02690 
AGB02700 
AGB027 1 0 
AGB 02720 
AGB02730 
ACB02740 
AGB02750 
AGB 02760 
ACB02770 
AGB 02780 
AGB 02 790 
AGB 028 00 
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AS  SUMMED  OVER  SIZES 
Du  25  0=1 , IT 

25  PSUM< J)=PSUM< J>+PHH< J> 

PZRSUM=PZRSUM+PFNZER 

URITE  <I0UT,27>  NK . I , NRADI , CTHHT 
NLINES=NLINES+NRADI 

END  LOOP  OVER  HALVING  INTERVALS  INDEXED  BY  I 

26  CONTINUE 

CALCULATE  PARTICLE  NUMBER  DENSITY<NO.  PER  CO  AS  DENSC 
DEH3C.=C0NC/<  RHOA*DRYVOL  > 

OVtRRIDE  CALCULATED  VALUt  OF  DENSC  WITH  DENS  IF  LLLL  =1 
IF  <LLLL.EQ.1>  DENSC=DENS 

RECALCULATE  CONC  FROM  OTHER  INPUT  DATA  IF  LLLL=1 
IF  <LLLL.EQ.1>  CONC=DEHS*RHOA>*DRVVOL 
REPLACE  DENS  BY  DENSC  FOR  LATER  USE  BY  ACXP3 
DENS=DENSC 

WEIGHT  CT3UM,ETC.  BY  NUMBER  DENSITIES  < DENSO  FOP  THIS  COMPONENT 

CTSUM=CTSUM*DENSC 

CS5UM=CSSUMi<DENSC 

CR5UM=CRSyM*DENSC 

vOL=vOL*DtNSC 

OL 1 SUM=OL 1 SUM*DENSC 

0L23UM=0L2SUM*DENSC 

DO  29  J=1 , IT 

29  P3UM< J)=PSUM< J JfDENSC 
P2RSUM=PZRSUM*DEHSC 

NOW,  SUM  OVER  COMPONENTS  INDEXED  BY  NX 

CONCT  IS  THE  TOTAL  DRY-AEROSOL  CONCENTRATION  IN  MG  PER  CC 

CONCT-CONCT+1 .E3*C0HC 

DEHST=DEHST+DENSC 

OLSTAR=OL  1  SUM-i-OLSTAR 

0M2=0L2SUM+0M2 

CTSUMT-CTSUMT+CTSUM 

AT  THIS  POINT,  CTSUMT  IS  THE  TOTAL  EXTINCTION  CROSS  SECTION 

<IN  SQ.  MICRONS)  AS  SUMMED  OVER  ALL  COMPONENTS  WHICH 

HAVE  BEEN  DEALT  WITH  THUS  FAR 

CSSUMT-CSSUMT+CSSUM 

CRSUMT=CRSUMT+CRSUN 

DO  30  J=1 , IT 

30  PSUMTT<  J)«=PSUM<  J>+PSUMTT<  J) 

PZRSMT=PZRSMTfPZRSUM 
VOL=VOL*1 .E-12 

TVOL  IS  THE  TOTAL  VOLUME  (IN  CM»*3)  OCCUPIED  BY  THE  AEROSOL 
PARTICLES.  TVOL  IS  NOT  ACTUALLY  USED  IN  THIS  VERSION  OF 
PROGRAM  AGAUS. 

TVOL=VOL+TVOL 

EMASS=VOLo<RHO 

TMASS-TMASS+EMASS 

KEXOLD=KEXTT 

KEXTT-CTSUMT-»1  .E-3 

KEXT=KEXTT-(<EXOLD 

WRITE  <I0UT,31)  NK, VOL,EMASS,KEXT 

VPF<VOL)  IS  THE  VOLUME  PACKING  FRACTION:  THAT  IS,  THE  FRACTION 
OF  EACH  CC  OF  SPACE  WHICH  IS  FILLED  BY  AEROSOL  MATERIAL  BELONGING 
TO  THE  CURRENT  COMPONENT  NK . 

TMASS  IS  THE  TOTAL  MASS  OF  AEROSOL  FOUND  IN  1  CC  OF  SPACE. 

EMASS  IS  THE  MASS  OF  AEROSOL  MATERIAL  PER  CC  ASSOCIATED  WITH 
THE  CURRENT  COMPONENT  NK . 

KEXT  IS  THE  EXTINCTION  C0EF.<PER  KM)  WHICH  IS  ASSOCIATED  WITH 
THE  CURRENT  COMPONENT--AS  IF  IT  ALONE  WERE  PRESENT. 

KEXTT  IS  THE  SUM  OF  THE  KENT'S  OVER  ALL  COMPONENTS. 

END  LOOP  OVER  AEROSOL  COMPONENTS  INDEXED  BY  NK . 

IF  (NIHDX.GT.I)  WRITE  <10UT,42)  NK 
IF  (MQRTE.EQ. 12345)  WRITE  <10UT,43> 

32  CONTINUE 

IF  (NIHDX.GT.I)  WRITE  <I0UT,33)  TMASS, KEXTT 

WRITE  (I0UT,34)  NLINES 

DEHS-DENST 

NRADl-NLINES 

NOW,  PERFORM  THE  FINAL  RENORMALIZATIONS  TO  OBTAIN  CTSUM,  ETC. 


AGB0281 0 
AGB 02820 
AGB02870 
AGB 02840 
AGB0285U 
AGB02860 
AGB 02870 
AGB 02880 
AGB02&90 
AGB 029 00 
AGB029 ) 0 
AGB 02920 
AGb02930 
AGB 02940 
AGB02950 
AGB 02960 
AGB 02970 
AGBC2980 
AGB02990 
AGB05000 
AGBOjOI 0 
AGB 03 020 
AGB03030 
AGB 03 040 
AGB03050 
AGB 03060 
AGB03070 
AGB03080 
AGB03090 
AGB 031 00 
AGBO.51  1  0 
AGB 03 120 
AGB031 30 
AGB03140 
AGB03150 
AGBD31 60 
AGB03170 
AGB03t80 
AGB 03 190 
AGB03200 
AGB 0321 0 
AGB03220 
AGB 03230 
AGB 03240 
AGB03250 
AGB 03260 
AGB03270 
AGB 07280 
AGB03290 
AGB03300 
AGB 0331 0 
AGB 03320 
AGB  0333  0 
AGB03340 
AGB 03350 
AGB03360 
AGB03370 
AGB03380 
AGB03390 
AGB03400 
AGB0341 0 
AGB03420 
AGB03430 
AGB03440 
AGB03450 
AGB03460 
AG603470 
AGB03480 
AGe03490 
AGB03500 
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C  VhLLIES  kEPRESENThTIVE  of  h  SIHOLE  AVERhGE  PhRTICLE. 

C  CTSUM  BECOMES  THE  EXTIHCTIOH  CROSSECTIOH  IN  SQ .  MICROMETERS  PER 

C  PVERHCE  PHRTICLE.  THE  OTHER  QUHNTITIES  CHRRV  SIMILhR  MEhNINGS. 

Du  35  J= 1 , I T 

35  PSUM<  J  )  =  PSUMTT<  J  ),^OEHST 
OLSTAR=OLSTHR,^CTSUMT 
0M2=0M2/'CTSUMT 
CTSUM=CTSUMT^DENST 
C3SUM=CSSUMTXDENST 
CRSUM=CRSUMT/’DEHST 

C  ...AND  CONVERT  ANG  INTENS  AT  ZERO  DEGREES  INTO  PHASE  FUNCT . 

C  WITH  NORMALIZATION 

PFI'I2RO=PZkSMT.>DE.NST*<  ii(IAVE>»WAVE/<  PI>*CT3UM*EMH’*‘EMM  >  > 

WRITE< lOUT, 36  >  OLSTAR, 0M2, PFNZRO 
C  CALCULATE  ATTENUATION  COEFS.  IN  SQ. METERS  PER  MILLIGRAM 

CATTN=CT5UMT*1 .E-12/C0NCT 
CATTHw=1  .  E-i  2*k'EXTTZ  I  MASS 
WRITE  tlOUT,37:i  CATTN 

IF<RELHUM.GT.  1  .  0>UIRITE  <I0UT,38)  CATTNUI 
GO  TO  41 

44  WRITE  <I0LIT,45';  EMA 
STOP 

2  FORMAT  i;  4^  i  0 . 6,  El  5 . 7  ) 

3  FORMAT  <1H  . 6H  IN0X=,I3,4H  M=  .F10.6.6H  K  =  -,F10.6,9HI.  MASS  , 

♦  1 OHDENSITY  =  ,F8.6, 

+  17H  GROWTH  FACTOR  =  ,F8.4,9H.  CONC  -  ,1PE12.5,7H  GMXCC/ > 

4  FORMAT  < 1X,F10.5,6<2X, 1PE1 1 .5>> 

5  FORMAT  </X54H  R< MICRONS >  DRY  RADIUS  NCR)  MIE  SIZE 

+  ,36HQ  <EXT>  Gi<SCA>  Q<  RADAR  >/  > 

9  FORMAT  <tH  ,39HINDEX  OF  REFRACTION  FOR  PURE  WATER  ISi  ,F8.6, 

+  3H  -  ,F8.6,  IHIX-MX^aSHMASS  DENSITY  OF  WATER  AT  ,F6.2, 

♦  tIH  DEG  C  IS:  ,F8.2,6H  CM/CC,/'> 

124  F0RMAT(XS2H  *•••*  CONVERGENCE  LEVEL  NOT  REACHED  FOR  INTERVAL  NO.  , 

^  1  3  ^  ^  ^  ^  ) 

27  FORMAT<1H  , 1 9H  FOR  COMPONENT  NO.  ,I3,15H  INTERVAL  NO.  ,I3,1H  ,14 

♦  43H  RADII  WERE  USED.  CONTRIBUTION  TO  CTSUM  «  , I  PEI  2. 6 > 

31  FORMAT  <1H  ,7,20H  FOR  COMPONENT  NO.  ,12,12H  :  VPF  »  ,1PE12.5, 

+7H  PER  CC,24H  MASS  CONCENTRATION  =  ,E12.5,21H  GM/CC .  NEXT  = 

+  ,  E12.5,7H  PER  KM > 

33  FORMAT  <1H  ,/’,29H  TOTAL  MASS  CONCENTRATION  =  ,1PE12.5,7H  GM/CC;  , 
+15H  TOTAL  KEXT  =  ,E12.5,7H  PER  KM> 

34  FORMAT  </lX,32H  TOTAL  NUMBER  OF  RADII  USED  WAS  ,I5> 

36  FORMAT  </lX,19H  ANALYTIC  SOLUTIONS,/, 

♦  16H  OMEGA  SUB  1  =  , 1  PE  1 4 . 7/ , I 6H  OMEGA  SUB  2  =  ,)PE14.7/ 

+,16H  PFN  AT  ZERO  =  ,1PE14.7,/> 

37  FORMAT  <1H  ,21H  ATTENUATION  COEF .  =  ,1PE12.5,12H  SQ-METERS/, 

+  33HMILLIGRAM  OF  DRY  AEROSOL  MATERIAL 

38  FORMAT  <1H  ,21H  ATTENUATION  COEF.  =  ,tPE12.5,12H  SD-METERS/, 

+  33HMILLIGRAM  OF  WET  AEROSOL  MATERIAL/) 

42  FORMAT  <tH  /, 1 X, 1  OX, 30< 1 H* ), 33H  END  OF  AEROSOL  COMPONENT  CYCLE  , 

+  7HNUMBER  , 13, 2X, 30< IH* >// ) 

43  FORMAT  <1H  ) 

45  FORMAT  <///,  1 X,  1  1  Hf EMA  <,Ff0.6,20H)  IS  EITHER  ZERO  OR  , 

♦  35HNEGATIVE  -  PROGRAM  TERMINATED  >»♦'*♦*> 

41  RETURN 

END 


AGB  035 1 0 
aGB''352  0 
AG.  03:^30 
AGB03540 
AGB03550 
AGB03560 
AGB0.J57U 
AGB035S0 
HUB  0339  0 
AGB03600 
AGB0361 0 
AGB 03620 
HUB  036^0 
AGB 03640 
AGP  0365  0 
Aub 0^660 
AuB  036?  0 
AGB 03680 
AGB03690 
AGB 037 00 
AubO^,'  1  0 
AGe03720 
AGB 03730 
AGBC3740 
AGe03750 
AGB0.3760 
AGB 03770 
AGB03780 
AGb03790 
AGBC3800 
AGB0381 0 
AGB03820 
AGB 03830 
AGe03840 
AGB03850 
AGB03860 
AGB03870 
AGBC38S0 
AGB03890 
AGB03900 
AGB0391 0 
AGB03920 
AGB03930 
AGB03940 
AGB03950 
AGB03960 
AGB03970 
h75039S0 
AGB03990 
AGB 04000 
AG60401 0 
AGB 04 020 
AGB 04 030 
AGB04040 
AGB 040^0 
AGB 04 060 
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THE  BLOCK  DHTH  ROUTINE. 


SUBROUTINE  hGXP3<  CTSUM, CSSUM, CR3UM,GNU, DENS, NINDK, 

+  WRVE.EM,CftY,EMI1.  IT,  lEND,  lANG  > 

COMMON  /PT2.'  PC<65>,0L<65j,RMS<65>,PSUM<fc5),PSUMT<65),P<65) 

COMMON  /lO/  lOIN, IOUT,NUNIT, IEO,NEOU 
COMMON  /AGXM/  C< 65 >, W< 65 >, OLT< 65  JDIMCK< 3 ) 

COMMON  /Pri/  F<513),R<513>,DR«r8>,RR<9>,FF<514;) 

+.MRADI,PI . IDSTP,NKG.HHALV,NI 
lEND^l  WHEN  THE  COMPOSITE  PHASE  FUNCTION  IS  BEING  WRITTEN 
it-  LitHD.Eu.O  GO  TO  6 
ALBC>0=CSSUM.''CTSUM 

PhOCT  IS  USED  TO  CONv'ERT  AVG .  INTENSITY  PSUMt  >  INTO  PHASt- 
FUNCTIONS.  SFACT  IS  USED  TO  CONVERT  PSUM  INTO  SCATTERING 
hPACTIONS,  NOP.MAl  IZfcD  PER  SOM.  THE  INTEGRAL  OF  SCAT  OVER  SOLID 
ANGLE  SHOULD  YIELD  THE  TOTAL  SCATTERING  CROSS-SECTION  IN  SQ.  M. 

S^  AC  T  =  WAVt*WAVE’*'DtN3>t'1  .  E-6/<  4  .  *PI*PI  ) 

PFACT  =  UAVE*WAVE.'<:  Pl*CTSUMf  EMM*EMM  > 

DO  15  J= 1 , I T 

SCAT  =  PSUM<  J>*SFACT 

PSUM<  J  >=PSUMc;  J  >>»PFACT 

UNCOMMENT  THE  FOLLOWING  STMT  IF  U  WANT  SCAT  FRACT , COS  I HES  AND  A 
COUNTER  WRITTEN  ON  NUNIT.  NUNIT  IS  SET  IN  THE  BLOCK  DATA  ROUTINE. 
WRITE  «;NUNIT,3)  SCAT,C<vI),J 
15  CONTINUE 

IF  <NINDj<,GE,2>  WRITE  <10111,12;) 

WRITE  <I0UT,4>  IDSTP,WAVE,EM,CAY,CTSUM,CSSUM, ALBDO 
CONVERT  AVG.  CROSS-SECTIONS  TO  COEFFICIENTS  <PER  KM) 

CTSUM=CTSUM>f1  .  OE-S^DENS 
CSSUM=CSSUM*i . 0E-3*DENS 
CRSUM=CRSUM*1  .  OE-S-fDENS 
WRITE  <10UT,13)  CTSUM,CSSUM,CRSUM 
WRITE  <I0LIT,14>  GNU,  DENS 
IF  <  IT.LT.2)  GO  TO  21 

WRITE  PHASE  FUNCTION  AT  SPECIFIED  ANGLES 
WRITE  < lOUT, 1 > 

WRITE  <  rOUT,5) 

FIND  ANGLES  FROM  COSINES 
DO  2  1=1 , IT 

FF<  I  )=180,*ATAN2<SGRT<  1  .-C<  I  )>**2),C<  I  >>/PI 

DO  19  J=1,1T,4 

K=J+3 

IF  <K.GT. IT)  K=IT 

19  WRITE  <I0UT,8)  <  C<  I  ),  FF<  I  ),  PSUM<  I  ),  1  =  J,  K  ) 

IF  ( lANG.NE. 0)  RETURN 

ROUTINE  GAUS  GENERATES  AND  PRINTS  THE  LEGENDRE 
EXPANSION  COEFS  <OMEGAS)  FOR  THE  PHASE  FUNCTION. 

CALL  GAUS< IT) 

CHECK  TO  SEE  IF  SNG .  SCAT.  ALBEDO  <ALBDO)  COMPUTED  DIRECTLY 
FROM  CROSS-SECTIONS  AGREES  WITH  THAT  FOUND  FROM  THE  LEGENDRE 
EXPANSION  OF  PHASE-FUNCTION. 

IF  << ABS<OL< 1  )-ALBDO  )/ALBOO . GT . 5 . E-3  )  . AND . < lEND . NE . 1  >> 

1  WRITE  < IOUT,20) 

1  FORMAT  <//1H  ,50X, 14HPHASE  FUNCT I ONX , 1 X , 42X, 3 1 H< NORMAL I2ED  TO  4  P 
+  OMEGA  2ER0)XX) 

FORMAT  <  2<E13. 7, IX ), 13  > 

4  FORMAT  <1H1,X,41H  DISTRIBUTION  WAVELENGTH  REFRACT  I VE , 9X , 

+  20HEXTINCTI0N  X  SECT  ION , 8X , 20HSCATTERING  X  SECT  I  ON , 1 2X , 5HALBD0/ 

+  1H  ,6X,  4HTYPE,6X,9H<MICR0NS),8X,5HINDEX,16X,12H<SQ  Ml  CRONS  ), 1 3X , 
+  12H<SQ  MICRONS  )/'1H  ,  19 , 4X ,  F 11  .  4 ,  F 1  0 . 4 , 3H<  1  - ,  F7 , 4 , 2H I  ) , 

+  7X,  IPE14.7,  1  tX,  1PE14.7,  12X,  1PEM.7,X) 

5  FORMAT  <1H  ,3X,4<5H  MU,2X,'  ANGLE  ',17H  PHASE  FUNCTION  >/ ) 

8  FORMAT  <1H  , F9 . 5 , F7 . 2 , E 1 2 . 5 , 3< 3X , F9 . 5 , F7 . 2, E 1 2 . 5 ) > 

12  FORMAT  <52H  THIS  IS  A  MIXED  CASE  SUBSEQUENT  REFRACTIVE  INDEX  , 

+  34HPR1NT-0UTS  ARE  NOT  GENERALLY  VALID/) 

13  format  <1H  ,10H  K<EXT)  =  ,1PE13.7, lIHj  K<SCA)  =  ,E13.7, 

+  11H;  K<RAD>  =  ,E13.7,11H  ALL  PER  KM/) 

14  FORMAT  </14H  WAVENUMBER  =  ,1PE12.6,5H  CM-1 , 5X, 1 OHDENSITY  =  ,E12.6 

♦  17H  PARTICLES  PER  CC/ ) 

20  FORMAT  <//12H  VALUES 

+  ,55H0F  ALBDO  AND  0L< 1 >  DISAGREE  BY  MORE  THAN  0.5  PERCENT  + 

♦  ,34HLARGER  VALUE  OF  'IT'  IS  NEEDED  ♦*♦/ > 


INDEX 


AGCO  001 0 
AGCO  0  02  0 
AGCOOOr'J 
AGC00040 
AGCO  005  0 
AGC00060 
AGC00070 
AGCOOOSO 
AGCO  009  0 
AGCOO 1 00 
AGCOOl 1 0 
AGCOOl 20 
AGCOOl 30 
AGCOOl 40 
AGc  uOt  50 
AGCOOl 60 
AGCOOl 70 
AGC00180 
AGCOOl 90 
AGO  0  02 0  0 
AGC0021 0 
AGCO  022  0 
AGCO  023  0 
AGO 002 40 
AGC00250 
AGC00260 
AGCuu270 
AGC002S0 
AGCu029u 
AGCO  03 0  0 
AGCO  031 0 
AGC00320 
AGC00330 
AGC00340 
AGC00350 
AGCO  036  0 
AGCO  037  0 
AGC00380 
AGC00390 
AGCO  04 00 
AGCO 04  I  0 
AGCO  0420 
AGC00430 
AGCO  044  0 
AGCO  0450 
AGC00460 
AGCO  047  0 
AGCOO  -PO 
AGCO  049  0 
AGCO  05 0  0 
AGC0051 0 
IAGC00520 
AGC00530 
AGCO  054  0 
AGC00550 
AGCO  056  0 
AGC00570 
AGCO  058  0 
AGCO  059  0 
AGCO 06 00 
AGCO  061 0 
AGC00620 
AGCO  063  0 
AGCO  064  0 
AGC00650 
, AGCO  066  0 
AGC00670 
AGCO  068  0 
*AGC0u690 
AGCO  07 0  0 


396 


V 


21 


RETURN 

END 


AGC0071 0 
AGC00720 
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SUBROUTINE  ANGLE< PI , lANG, IT > 

ANG0001 0 

c 

THIS  ROUTINE  IS  TO  BE  USED  TO  REPLACE  GUSET  FOR 

THE 

PURPOSE 

ANG00020 

c 

OF  USING  AGAUS  TO  DO  PHASE  FUNCTION  CALCULATIONS 

AT 

-IT- 

ANG00030 

c 

ANGLES  BETWEEN  0  AND  180  DEGREES,  RATHER  THAN  AT 

THE 

G-L 

ANG0004. 

c 

QUADRATURE  ABSCISSA  VALUES.  IT  ALSO  READS  THE  INPUT 

ANGLES 

ANGOOOSO 

c 

IF  IANG=2. 

ANC00060 

COMMON  /lu/  lOIN, IOUT,NUNIT, lEO.NEOU 

ANG00070 

COMMON  /AGNM/  C< 65 > , W< 65  ) , OLT< 65  ), JDI MCK( 3 > 

ANG00080 

RADS=PI/’180. 

ANGOOOSO 

DEL=1  80. /FLOAT*:  IT-1  > 

IF  < lEO.EO. 1 .OR. IE0.EQ.2.0R. IE0.E0.5>  GO  TO  4 

ANG001 00 
ANG001  1  0 

IF  <IANG.EQ.2>  GO  TO  2 

ANG00120 

DO  i  1=1, IT 

ANG001 30 

W< I )=DEL*FLOAT< 1-1  ) 

ANG00140 

i 

C<  I  )=COS<  Ul<  1  jx'RADS  ) 

ANG001 50 

RETURN 

ANG00160 

2 

REhD<.5,100>  <U<  I  ).  1-1  ,  IT) 

ANG001 70 

4 

DO  3  1=1 , IT 

ANGOOieO 

3 

C'',  I  )=COS<;  U<  I  )*RADS  ) 

ANG00190 

IANG=1 

ANG00200 

RETURN 

AHG0021 0 

1  00 

FORMATC 16F5. 1 ) 

ANG00220 

END 

AHG002.j0 
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FUNCTION  GrtMMA<X) 

C  GrtMMA  FUNCTION:  TAKEN  FROM  HANDBOOK  OF  MATHEMATICAL  FUNCTIONS, 

C  ABRAMOWITZ  AND  STEGUN,  NOV  1964,  PP  236-257.  RECURRENCE  FORMULA 

C  6,1.16,  POLYNOMIAL  APPROXIMATION  6.1.35. 

DATA  A1  A9  A7  A4  Al 

+  574^(646,  .95 1^363, -.6998598,  .  4245549 1  0 1  OSZe/* 

C  COMPUTER  AND  GAMMA  FUNCTION  LIMITS 

IF  <X.GT,34,  .OR.X.LT. 0.  i  GO  TO  3 
GSUM=1 . 

N=IFIX<X+. 00001 > 

C  FIND  Z  .LE.  1 . 

2=X-FL0AT<N> 

C  CK  FOR  Z  BEING  INTEGER 

IF  <2.LT. 1 ,E-04)  N=N-1 
IF  (Z-LT. 1 .E-04)  2=1 . 

C  COMPENSATE  FOR  N-1  IN  FORMULA 

N=N-1 

C  IF  Z  .LE.  1 .  SKIP  LOOP 

IF  <N.LE.0)  GO  TO  2 

C  RECURRENCE  RELATION:  G< N+2 >-< N- 1 +2 >*< N-2+2 > . . . < 1 +Z >fG< 1 +2 > 

DO  1  1=1, N 
VALUE=FLOAT< I  )+2 

1  G3UM=GSUM*vALUE 

C  POLYNOMIAL  APPROXIMATION:  Z.LE.1 

2  GAMMA=1  . +A1  ♦Z+A2=2‘i'2-*-A3*2'*2Hi2+A4'*'2*2=2=Z+A5*2*Z*Z=Z=2 
GAMMA=GAMMA*GSUM 

RETURN 

3  WRITE  < 1 , 1 00  >  X 

100  FORMAT<1H  ,'  *****  THE  VALUE  OF  X  <  ' , 2PE 1 1  . 4 ,  ' >  IS  EITHER  ', 

♦  'OUTSIDE  COMPUTER  LIMITS', X,'  OR  NEGATIVE  -  PGM  STOPPED  ■**■*=•'> 
STOP 
END 


GMAOuOl 0 
GMA00020 
GM(  0  0030 
GMA00040 
GMA00050 
GMA00060 
GMA00070 
GMAOOOSO 
GMA:j0090 
CMA001 00 
GMAOOI 1 0 
GMA001 20 
GMAOOI 30 
GMAOOI 40 
GMA00150 
GMAOOI 60 
GMA  0017  0 
GMAOOI 80 
GMAOOI 90 
GMA 002 00 
GMA0021 0 
GMA00220 
GMA00230 
GMA 00240 
GMA 00250 
GMA0D260 
GMA002i'0 
GMA 00280 
GMA00290 
GMA00300 
GMA0031 0 
GMA 00320 
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SUBROUTINE  GUSEKIT) 

THIS  ROUTINE  CALCULATES  THE  ABSCISSAE  C<  > 

AND  CAUSS-LECENDRE  UEIGHTS  U<  >  EOR  NUHERICAL  INTEGRATION 
VIA  GAUSS-LEGENDRE  QUADRATURE  OF  ORDER  N 
COMMON  /lO/'  lOIN,  IOUT,NUNIT,  IEO,NEOU 
COMMON  /’AGXM^  C<  65  5 ,  W<  65  > ,  OLT<  65  ),  JD IMCKt  3  > 

COMMON  /PT1/  F<513>,R<513;,DR<8>,RR<9),FF<514> 

+,NRADI,PI. IDSTP,NKG,NHALV.NI 
H=IT 

TOL=1 . OE-06 

AA=2 . 0E+0u/PI*>»2  .  OE+00 

AB=-62 . E+00/<  3.0E+00*PI**4.0E+00> 

AC=1  51  1  6  .  OE+OCiyi  1  5 . 0E+00%PI*6  ,  Ot+00  > 

AD=-12554474, 0E+007< 1 05 . 0E+00*PI*8 . OE+00 > 

F< 1 >=1 . OE+UU 
EN=  FLOAT<N> 

NP1*n+1 

U=1  .  0E+00-<2. 0E+00,-‘PI  )**2.  OE+OO 

D=1  .  OE+00/‘SQRT<:<EN+0.5E+00)-»*2.E+00+U/4.  OE+00) 

DO  1  1=1, N 
S=  FLOAT< I  ) 

Af4  ,  OE+OOh'S-1  .  OE+00 

Uk  sUUy’u 

AF=AB7A>**3.  OE+00 
AG=AC7A>»>»>5 .  OE+OO 
AH=AD/’Ah<*7 . 0E+  00 
i  RiC  I  :)=Pl*<A+AE+AF+AG+AH>74.E+00 
DO  6  k= 1 , N 
X=COS<  R<K)fD> 

?  F<2>=X 
DO  3  NN=3,NP1 
£NH=  FLOAT<NN-1) 

FCNN  )=<<2. 0E+00*ENN-1  .  E+ 00  >>»XfF<  NN-1  >-<ENN-1  .E+00>*F<NN-2  >  >7ENN 
IF  <ABS<F<NN)).GT. 1E+3S)  F<HN  ;=SIGN< 1 .E+35.F< HN ) ) 

PNP=EN>i><  F<  N  >-X*F<  NP 1  >  V<  1  .  0E+  0  0-XfX  > 

XI=X-F<NP1  .VPNP 
XD=  AeS<XI-X) 

XOO=XD-TOL 
IF  (XOO)  5,5,4 
1  X=XI 
GO  TO  2 
i  C<K>=X 

W<K)=2. 0E+00*<  1  .  0E+00-XfX)/'«:EN*F<:N>*EN*F<N:») 

DO  7  1=1 ,N 
R< I  )=0 . 00 
’  F< I  )=0,00 
RETURN 
END 


GUSET  01 0 
GUSET020 
GUSET 030 
GUSET04.j 
GUSET  050 
GUSET 060 
GUSET070 
GUSET080 
GUSET090 
GUSET 1 00 
GUSET 1 i 0 
GUSET 120 
GUSET 1 30 
GUSET 1 40 
GUSET150 
GUSEI160 
GUSE 11 70 
GUSET ISO 
GUSET ISO 
GIJSET200 
GUSET21 0 
GUSET220 
GUSET230 
GUSET240 
GUSE 1 250 
GUSET260 
GUSET270 
GUSET280 
CUSET290 
GUSET300 
GUStT31 0 
GUSET320 
GUSET330 
GUSET340 
CUSET350 
GUSET360 
GUSET370 
GUSET380 
GUSET390 
CUSET400 
GUSET41 0 
CUSEr420 
GUSET430 
GUSET440 
GUSET450 
GUSET460 
GUSET470 
GUSE'r480 
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SUBkOUT I  Wt  MI tG.y«'  EMD  ,  ChYD ,  hL PHAD,  QTD,  OSD ,  QRD ,  P ,  0 i  STkD 02STkD, 

+C, IT,PFH2RO) 

C  THIS  ROUTINE  IS  CURRENTLY  SINGLE  PRECISION  COMPLEX 

C  CHANGE  THE  VALUE  OF  NDIM  IF  YOU  CHANGE  THE  DIM  OF  A  IN  NEXT  LINE 
COMPLEX  A<  600  >, ACAPN, 2NUM, 2DEN, 2P0T, 2RPDT . 2AN. 2ANP , Y , RF , RRF, 

1  RRFX.WMI .FNA.FNB.TCl < FNAP , FNBP > FNAPP . FNBPP , TC2 , WFH< 2 > 

COMMON  /lO/  lOIN, I0UT,NUN1T. IEO,NEOU 
DIMENSION  P<65>,C<65> 

DIMENSION  T<  4  TA<  4  >,TB<  2 ), TC<  2  >, TD( 2  >, TE<  2  TF<  2  >, TG<  2 ) 

DIMENSION  ELTRMX<4,76),PI<3,76),TAU<3,76> 

EQUIVALENCE  <  UFN<  1  ),TA<  1  )),<FNA,TB<  1  >),<FNB,TC':  1  >J,<FNAP,TD<  1  )) 
EQUIVALENCE  <FNBP,TE<  1  )  ) ,  <  FNAPP ,  TF<  t  >  > ,  <  FNBPP ,  TG<  1  >  )  „ 

C  THESE  EQUIVALENCES  ALLOW  USE  OF  REAL  AND  IMAG  PARTS  INDIVIDUALLY 

TOL  =  1 . E-06 
ITT=IT 
X=<  ALPHAO  > 

CAY=<  CAYD ; 

EM=<EMD j 
CAYE=CAY>*'EM 
QRT=0. 0 

rf=cmplx<:em.-caye) 

NMX=IFIX<  X>f<  EM+CAYE  )  )+9 
RRF=1 . O^RF 
RX=i . 0/X 
RRF^^RRFx'RX 

C  LOOP  POINT  FOR  CALCULATING  PFN  AT  ZERO  DEGREES 
lAPXCT-O 
2i  CONTINUE 

C  THESE  ARE  THE  PI  AND  TAU  FUNCTIONS 
DO  1  U=1,IT 
PI<  t  ,  J)=0. 0 
PI<2.  J)«»1  .  0 
TAUC 1 , J)=0. 0 
TAU<2, J>=C<  J> 
t  CONTINUE 
T<  1  >*COS<X> 

T<2>«SIN<X) 

UM1«CMPLX<T< 1 >,-T<2)> 

WFN<  1  )=CMPLX<T<2>,T<  1  )) 
gFN<  2  )*=RX*WFN<  1  )-WM1 
T< 1  )=CAYEfX 
N=1 

C  NDIM  MUST  EQUAL  THE  DIMENSION  OF  A<  >. 

NDIM=600 

IF  <HMX,LT.NDIM)  NDELTA=NMX 
IF  <NMX,GT,NDIM)  NDELTA=NOIM 
HMX=rj 

IF  <N.EQ. 1 )  GO  TO  4 

2  EN=FLOAT<N> 

T< 1 j=2. OfEH-1 . 0 
T<2)=EN-t  .  0 
T<3>='2. 0*EM+1  .  0 
DO  3  J»1,IT 
PI1J=PI< 1 , J) 

PI2J=PI<2, 

CJ-  C<  J> 

C  SWITCH  FOR  CALCULATING  PFN  AT  2ER0  DECREES 
IF  < lAPXCT.EQ. 1 )  CJ=1 . 0 
S2T=<1 .0-CJ*CJ> 

PI<3,  J>-<T<  1  )'*PI2J*CJ-EN*PI  t  J>/T<2> 

TAU<3,  J)-CJ-KPI<3,  J)-PI1  0)-T<  1  )*S2T*PI2  J+TAU<  1  ,  J  > 

3  CONTINUE 
WM1*WFN< 1 > 

UFN<  1  >-WFN<2> 

WFN<  2 )-T< 1  )*RX*WFN< I >-«M» 

4  CONTINUE 

C  CALCULATE  RATIO  OF  BESSEL  FNS  OF  CONSECUTIVE  ORDER 
IF  <N.LT .<NMX+i ))  GO  TO  9 
NMX=NMX+NDELTA 


MIEGYul u 
MIEGXC20 
MIt  GX030 
MIEGX040 
MIEGX050 
MIEGX060 
MIEGX070 
MIEGX080 
MIEGX090 
MIEGX1 00 
MIEGX1 1 0 
MIEGX120 
MIEGX130 
MIEGX14CI 
MIEGXi5& 
MIEGX»60 
MIEGXl 70 
MIEGXISO 
MItGxISu 
MIEGX200 
MIEGX21 0 
MIEGX220 
M1EGX230 
MIEGX240 
MIEGX250 
MIEGX260 
MIEGX27  0 
MIEGX280 
MI£GX29u 
MIEGX300 
MIE&X31 0 
MIECX320 
MIECX330 
MIEGX340 
MIEGX350 
MIEGX360 
M1EGX370 
MIEGX3B0 
HIECX390 
MIEGX400 
MIEGX41 0 
MIEGX420 
M1EGX430 
MIEGX440 
MIEGX450 
MIEGX460 
MIEGX470 
f.IEGX48  0 
MIEGX490 
M1EGX500 
MIEGX51 0 
MIEGX520 
MIEGX530 
MIEGX540 
MIECX550 
MIEGX560 
MIEGX570 
MIEGX580 
MIE&X590 
MIEGX600 
MIEGX61 U 
MIECX620 
MIEGX630 
M1ECX640 
MIEGX650 
MIEGX660 
MIEGX670 
MIEGX680 
M1EGX690 
MIEGX700 
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HMIn=NM?<-H-NDELTA 

V=FLOAT<NMX)+0,50 

V=RF*X 

2ANP=2. OXY 

2NUM*ZhNP*V 

ZPDT-ZNUM 

V=V-H  .  0 

2DEN=ZANP*V 

2KUri=ZDEN-1  .  0/ZNUM 

5  ZRPDT=2NUM/ZDEN 
2PDT=2KPDTf2PDT 

IF  <'ABS<REAL<2RPDT)-1  ,  0>.LT.  TOL  >  GO  TO  7 
IF  V  .  LT  .  ZOOOO  .  0  i  GO  TO  6 
WRITE  <rOWT,tOOO>  X, EM, CAVE 
STOP 

6  V=V-*-i  .  0 
ZhN=2ANP*V 
Zt-aiM=ZAN-1  .  OXZNUM 
Zl>EN=ZhN-1  .  uXZDEN 
GO  TO  5 

7  CONTINUE 
J=NMX 

8  JJ= J-NMX+NDELTA 

A<  J  J  >— <  FLOhT<  J  >  VV+ZPOT 

Ja  J—  1 

IF  (J.LT.NHIN)  GO  TO  9 

2PDT=<2. 0*FLOAT< J)+1 .0)ZY-1 . OZZPOT 

GO  TO  8 

9  CONTINUE 
J=>N-NMX4N0ELTA 
hCAPN=A<  J) 

IF  <N.GT. i  )  GO  TO  H 

THIS  PART  FOR  N  EQUAL  1  ONLY 

TC1=ACAPH*RRF+RX 

TC2*ACj^PN^RF+RX 

SEe'eQUIVALEHCE  stmts  FOR  EXPAHATION  OF  TA<  >,  ETC. 

FNA»<  TC » ♦TA<  3  >-TA<  1  )  )/<  TC  J  ■•'UFN<  2  >-UFH<  1  >  ) 

FNB«<  TC2-*TA<  3  )-TA<  1  >  )/<  TC2*UFN<  2  >-WFH<  1  >  > 

FNAP=FNA 

FNBP*FN8 

T< 1 >=1 .50 

TB<  1  >«T<  t  >'»TB<  1  ) 

TB<2)=T<  t  )fTB<2) 

TC< 1 )=T< ( >»TC< 1 > 

TC<2)=T<  1  )t.TC<2> 

00  10  J=1,IT 
TAU2J»TAU<2, J) 

ELTRMX<  1  ,  J  )-TB<  1  >+TC<  1  )-»TAU2  J 
ELTRMX<  2, J  )»TB<  2  )+TC<  2 )*TAU2 J 
ELTRMX<  3,  0  )>*TC<  1  )+TB<  1  )*TAU2  J 
ELTRMX<4,  J5=»TC<2)+TB<2)*TAU2J 

10  CONTINUE 

QEXT=2.0*<TB<1 >+TC<  1  )> 

QSCAT=<  TB<  1  )>*T8<  1  )+TB<  2  )»TB<  2  )+TC<  1  )'*TC<  1  >+TC<  2  >>*'TC<  2  >  >X0 . 750 
01STAR=0. 0 
02STAR-0. 0 

SUMRR=2 . Of<  TB< 1 >-TC< 1 ) ) 

SUMRI»2 . 0*<  TB<  2  >-TC<  2 ) ) 

N=2 

GO  TO  2 

1 1  CONTINUE 

TC 1 »ACAPN%RRF+EN»RX 
TrSaAr  APMttPP+PKlAEy 

SEE  EQUIVALENCE  STMTS  FOR  EXPLANATION  OF  TA<  ),  ETC. 

FNA=<  TC  1  tiTA<  3  >-TA<  1  )  )/<  TC  1  ♦WFN<  2  )-WFN<  1  >  > 

FNB»<  TC2*TA<  3  >-TA<  1  )  >/'<  TC2>*WFN<  2  >-WFH<  I  >  > 

T<4)=T<  1  )AEN*T<2>> 

T<  2  >=<  T<  2  >*<  EN+ 1  .  0  >  >ZEN 

luMRR=SUMRR+S*T<  3  >*•<  TB<  1  )-TC<  1  )  > 


MIEGX7i 0 
MIEGX720 
MI  80X73  ■■ 
MIEGX740 
MIEGX750 
MIEGX760 
MIEGX77ii 
MIEGX7tiO 
MIEGX790 
MIEGXSOO 
MIEGXb  >  u 
MIEGX820 
MIEGX830 
MIEGX840 
MIEGX85CI 
M1EGX860 
MIEGX870 
MIEGX8S0 
MIEGX890 
MIEGX900 
MltuXSI 0 
MIEGX92ij 
MItGX93u 
MIEGX940 
MiE&X950 
MIEGX960 
MIECX97U 
MIEGX980 
MIEGX990 
MIEGXOOO 
MIEGX01 0 
MIEGX020 
MIEGx030 
MIECX040 
MIEGX050 
M I  EG X 080 
MIEGX070 
MIEGXOOO 
MIEGX090 
MIEGX1 00 
MIEGX1 1 0 
MIEGX120 
MIEGX150 
MIEGX140 
MIEGX150 
M1EGX160 
MIEGX170 
MIEGX; 90 
MIEGX190 
MIEGX200 
MIEGX21 0 
MIEGX220 
MIEGX230 
MIEGX240 
MIEGX250 
MIEGX260 
MIEGX270 
M1EGX280 
MIEGX290 
MIEGX300 
MIEGX31 0 
MIEGX320 
MIEGX330 
MIEGX340 
MIEGX350 
NIEGX360 
MIEGX370 
MlEGXSeO 
MIEGX390 
MIEGX400 
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ooon 


\ 


I 


13 


M 


1b 


17 


SUMftI=3UMKl+S*T<  3  >♦<  Tb<  2 i-TC<  2  >  > 

SEE  LATER  COMMENTS  ABOUT  FOLLOWING  STATEMENTS 
QRTLl  =GIkT 

QRT=SUMRR*SLIMRR+SUMRI*SUMRI 
OISTAR  CALCULATION 

01  STAR=01  STAR-K  TB<  1  >*TD<  1  >+TB<  2  >>*TD<  2  >+TC<  1  )‘*TE';  1  >+TC(  2  >*TE<  2  >  ) 
1  *!<.  2  >-*4 . 0+4 . 0>»T<  4  >>f <  TD<  1  )fTE<  1  >+TD<  2  TE<  2  >  > 

IF  <;n.lt.3)  go  to  12 
02STAR  CALCULATION 

F1=TF<  1  )+TF<1  >+TF<2:>*TF<2>+TG<  1  )+TG<  1  >+TG<  2  >+TG<  2  ) 

F2s=TB<;  i  >+TFt  1  >+TB<  2  J+TFc  2  >+TC(  1  j^TG^  1  >+TC<  2  J+TGc  2  > 

F3=TD<  1  >*TG<  1  >+TD<  2  .)*TG<  2  ;i+TE<  1  >+TF<  1  >+TE<  2  >*TF<  2  > 

ENL1=FH-1 . 0 

C0F1  =2 .50*<<EN-2. 0  >*EHL1 -3 . 0  >*<  <  EN-2 . 0  >‘*ENL1 -3 . 0  :)*<;2 . 0*EN-3, 0>/ 
1  <  EN-2 . 0  j+ENL  1  +<  2  .  o+EN-l  .  0  >■*'<  2  .  O+EN-5 . 0  >  > 

C0F2  =  7 . 50>*<  EN-2 . 0  )*<  EN+  1  .  0  >/<  2 . 0*£N-  1.0) 

CuF3=15. 07ENL1 

02STAR*02STAR+COF1 ♦F 1 +C0F2*F2+C0F3fF3 
CONTINUE 

GiEXT=>QEXT+T<  3  )*<  TB<  1  >+TC<  1  )  > 

T<  4  )=TB<  1  )*TB<  1  )+TB<  2  )+TB<  2  >+TC<  1  >+TC<  1  >+TC<  2  >'«‘TC<  2  ) 

QSCAT-QSCAT  +  Tt  3  >+T<  4 ) 

T< 2 >=EN+< EN+ 1 . 0 > 

T<  1  )=T<3>7T<2) 

DO  13  J*1,IT 
P13J=P1<3, J) 

TAU3J=TAU<3. J) 

ELTRAXC  1  ,  J  )«ELTRM>«  1  ,  J  )+T<  1  )*<  TB<  1  )*P13  J+TC<  1  )*TALI3  J  ) 

ELTRMX<2, J)-ELTRMX<2, J )+T< 1  )  +  < TB< 2 )*PI3 J+TC< 2 )+TAU3 J  ) 

ELTRMX<3>  0>=ELTRMX<3.  J>+T<  1  )*><  TC(  1  )*PI3J+TB<  1  >'*TAL130> 

ELTRMX<4, J)=ELTRMX<4, J )+T< 1  )*< TC< 2 )*P13 J+TB< 2  )%TAU3 J  ) 

CONTINUE 

IF  <N,LT.5>  GO  TO  14 
QRTR=ABS<<QRT-QRTL1 >/QRT> 

TEST  FOR  CONVERGENCE  ON  QEXT.  Q3CA,  AND  QRADAR 
IF  <<T<4),LT.  TOL  ) , AND . < ORTR . LT .  TOL  >>  GO  TO  16 
N=N+1 

DO  15  J=1,IT 
PI< 1 , J)=PI<2, J) 

PI<2. J)=PI<3,  J) 

TAU<  1  ,  J)=»TAU<2,  J> 

TAU<2,0)=TAU<3.  J) 

CONTINUE 

FNAPP=FNAP 

FNBPP=FNBP 

FNAP=FNA 

FNBP=FNB 

GO  TO  2 

CONTINUE 

DO  18  J=1,IT 

DO  17  1=1,4 

T<  I  :>»ELTRMX<  I.  J) 

CONTINUE 

ELTRMX<  1  ,  J  >=T<  3  )*T<  3  >+T<  4  >■* T<  4  > 

ELTRMX<2,  J)=T<  1  )>»T<  1  )  +  T<2)*T<2) 

ELTR«X<3, J)=T< 1  )*T< 3  )+T< 2 )*T< 4 ) 

ELTRMX<4,  J>=<T<2)-»T<3)-T<4)*T<  1  >> 

PFHZRO-  <  ELTRMX< 1 , J  )+ELTRMX<  2 , J ) )/2 , 0 
1  )  GO  TO  20 


IF  <  lAPXCT .EQ 
P<  J)=PFNZRO 
18  CONTINUE 

ELTRMX<2,J>  IS 
ELTRMX<1,J)  IS 
ELTRMX<3,J>  IS 
ELTRMX<4,J)  IS 
T<  1  )=2 . 0>*RX*RX 
SGT=QEXT>*T<  1  ) 

SGS=QSCAT*T< 1  ) 

01  STAR-3. 0*01STAR/’<Xi'Xt<SGT> 
02STAR-4 . 0*023TAR7<  X*X*SGT  > 


THE  VERTICAL  COMPONENT  SCATTERING  II  <EVE1> 

THE  HORIZONTAL  COMPONENT  SCATTERING  12  <EYE2) 
EQUIVALENT  TO  EYE3 
EQUIVALENT  TO  -1.0'*EYE4 


MIEGX4 i 0 
MIECX42C' 
MI^Gj',43  0 
MIEGX440 
MIEGX45CI 
MIEGX460 
MIEGX470 
MIEGX480 
MIEGX490 
MIEGX500 
MIEGX5I u 
MIEGX520 
MlEGXb.j  0 
MIEGX540 
MiEGX550 
MIEGX560 
M1EGX570 
MIEGX5S0 
MIEGKdSO 
MIEGX6  uO 
MIEGXb i 0 
MIEGX620 
MItG.Xfc3  0 
MIEGX640 
MIEGXboO 
M1EGX660 
MIEGX670 
MIEGX680 
MIEGX690 
MIEGX700 
MIEGX71 0 
MIEGX720 
MIEGX730 
MIEGS’74Ci 
MIEgXi'50 
MIEGX760 
MIEGX770 
MIEGX780 
MIEGX790 
MIEGX800 
M1EGX81 0 
MIEGX820 
M1EGX830 
MIEGX840 
MIEGX850 
MIECX860 
MIEGX87U 
rilEGXSSO 
MIEGX890 
M1EGX90U 
M1EGX91 0 
MIEGX920 
MIEGX930 
MIEG,';94  0 
MIEGX950 
MIEGX960 
MIEGX970 
MIEGX980 
MIEGX990 
MIEGXOOO 
HIEGX01 0 
MIEGX02CI 
MIEGX030 
MIEGX040 
M1EGX050 
MIEGX060 
M1EGX070 
MIEGX08CI 
MIEGX090 
MIEGXl 00 
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SGR=<SUMRR*3UMRR+3UHRI»SUMRI  >>fRXKR:<  MltCXMO 

QTD=<SGT)  M1EGX120 

035=^303 >  MIEGXtTO 

QRD=<SGR)  M1EGX140 

013  iRD=<01STAR  >  rilEQXi  50 

02STRD=<02STAR)  ^  MIEGX160 

LOOP  FOR  CALCULATION  OF  PFN  AT  ZERO  DEGREES  -  FOR  lPhhSX  rtIEGXI7£i 

IAPXCT=1  MIEGXieO 

IT*1  liJEGXivu 

GO  TO  21  H1EGX20C 

20  IT=ITT  rliEGk21u 

RETURN  M1EGX220 

1000  FORMAT  < 52H  V  GT  20000  ERROR  IN  CONTINUED  FRACTIONS  MIE  ROUTINF,  MIEGj<25u 

1  11H  •*  ALPHA  «.E12.6,6H  EM  =  ,E12.6,7H  CAY  =  , E i 2 . 67 ,  MIEGX24C 

2  1X,54H  IT  IS  SUGGESTED  THAT  TOL»1,E-06  FOR  SINGLE  PRECISION.  )  MIEGX250 

END  MIEGX260 


} 
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SUBROUTINE  WATERC  WAVE,  EMT,  C|i«VT,TMCHUft,  RHODEN  >  WAT u 00 10 

COMMON  /lO/  lOIN, 10UT,NUNIT, IEO,NEOU  WATC0020 

REAL  LAMBDAC  169),NSUBR(:i69),NSUEtI<  169>  UATJ0030 

DIMENSION  TEMP<7),DEHS<7>  UIAT00040 

THIS  PROGRAM  SEARCHES  HALE  AND  QUERRY  TABLE  FOR  REFRACTION  VS.  WAT00050 

WAVELENGTH  <APPHED  OPTICS,  VOL.  12,  NO.  3, MARCH  1973, PG  555)  WAT00060 

AND  THE  DENSITY  VS.  TEMPERATURE  < HNDBK  OF  CHEM  AND  PHYS )  .  WAT00070 

IF  THE  INPUT  VALUES  <TMCHUR  AND  WAVE)  ARE  NOT  IN  THE  TABLES,  A  UATOOOSO 

LINEAR  INTERPOLATION  IS  COMPUTED.  VALUES  ACCURATE  TO  THREE  PLACES.  UAT00090 
INTEGER  P, POINT, H  UAT00100 

TABLES  FOLLOW  FOR  60  LINES  _  UAT00110 

DATA  LAMBDA/ 0 . 200,  0 . 225 , 0 , 250 , 0 . 275,  0.300,  0 . 32t',  o  ,  350,  0.375,  0,400  WATOOl  20 

1 ,  0.425, 0.450, 0.475, 0.500,0.525, 0.550, 0.575, 0,600, 0,625, 0.650  WATOOl 30 

2,  0.675,0.700,0,725, 0 . 75 0 , 0 . 775, 0 . 80 0 , 0.825, 0,850, 0.875, 0,900  WATOOl 40 

3,  0.925 . 0 .950,  0.975, 1.000,1.200,1.400,1.600,  1,800,2,000,2.20  0  WAT  001 50 

4,  2. 400, 2, 600, 2, 65 0,2, 700, 2. 75 0,2, 80 0,2. 85 0,2, 900, 2, 95 0,3. 000  WATOOl 60 

5,  3. 05 0,3. too, 3. ISO, 3. 200, 3. 25 0,3, 300, 3. 35 0,3. 400, 3. 450, 3. 500  WATOOl 70 

6,  3. 6 00, 3, 700, 3. 800, 3, 900, 4. 000, 4, 100, 4, 2 00, 4, 300, 4, 400, 4. 500  WATOOl 80 

7,  4. 600, 4. 7 00, 4. 300, 4. 900, 5. 00 0,5. too, 5. 200, 5. 3 0  0, 5. 400, 5. 500  WAT 0  01 9  0 

8,  5. 600, 5. 700, 5, 800, 5, 900, 6. 000, 6. 100, 6. 200, 6, 3 0  0, 6, 400, 6, 500  WAT 0  02 0  0 

9,  6. 600, 6. 700, 6. 800, 6. 900, 7, 00 0,7. 1  00, 7, 200, 7, 300, 7, 400, 7, 500  WAT  0  021  0 

X,  7. 600, 7. 700, 7. 800, 7. 900, 8. 00 0,8. 200, 8, 400, 8.600, 8. 800, 9, 000  WAT 0  022  0 

1,  9.200,9.400,9.600,9.800,10.00,10.50,11  .00,11  .50,12.00,12.50  WAT 0  023  0 

2,  13.00,13.50,14.00,14.50,15.00,15.50,16.00,16,50,17.00,17.50  WAT 0  024  0 

3,  18, 00, 18. 50, 19. 00, 19. 50. 20. 00, 21. 00. 22. 00, 23. 00, 24. 00, 25. 00  WAT 0  025  0 

4,  26, 00, 27. 00, 28. 00, 29. 00, 30. 00, 32. 00, 34. 00, 36. 00, 38. 00, 40. 00  WAT 0  0260 

5,  42, 00, 44. 00, 46, 00, 48. 00, 50. 00, -"0.00, 70. 00, 80, 00, 90. 00, 100.0  WAT  0  027  0 

6,  110. 0,120, 0,130,0, 140.0, 150,0, 160. 0,170. 0,180. 0,190, 0,200,0  WAT 0  028  0 

7  /  WAT00290 

DATA  NSUBR/1 .396, 1 ,373, 1 .362, 1 .354, 1 .349, 1 .346, 1 .343, 1,341,1 .339  WAT00300 

1 ,  1  .338, 1 .337, 1  .336, 1  .335,1  .334,1  .333, 1  .333, 1  .332, 1  .332, 1.331  WAT  0031 0 

2,  1.331,1.331,1.330,1.330,1  .330, 1 .329, 1  .329, 1  .329, 1  .328, 1  ,328  WAT  0  032  0 

3,  1  .328, 1  .327, 1 .327,1  .327, 1  .324,1  .321,1.317,1.312,1.306,1  .296  WAT  00330 

4,  1 ,279, 1 .242, 1.219,1.188,1.157,1.142,1.149,1.201,1 ,292, 1,371  UAT00340 

5,  1  .426,  1  .467, 1 .483, 1  .478,  1 .467,1  ,450,1  .432, 1.420,1.410,1.400  WAT  0  035  0 

6,  1  .385, 1  .374, 1  .364,1  .357. 1  .351,1  .346, 1  .342, 1  .338, 1  .334, 1  .332  WAT  0  036  0 

7,  1  .33  0, 1  .330, 1.330,1  .328, 1 ,325,1 .322, 1.317,1.312,1.305,1  ,298  WAT  00370 

8,  I .289, I .277, 1 .262, I .248, 1 ,265, I ,319, 1 .363, 1 .357, 1 .347, 1 ,339  WAT00380 

9,  1  .334, 1  .329, 1  ,324, 1.321,1.317,1.314,1.312,  1.309,1.307,1.304  WAT  00390 

X,  1.302,1  .299, 1  .297, 1  .294,1 .291,1  .286,  1.281,1  .275,1  .269, 1  ,262  WAT  004 00 

1 ,  1 . 255 , 1 . 247 ,1,239,1. 229 ,1,218,1.185,1.153,1.126,1.111,1.123  WAT  0041  0 

2,  I  , 146,  1  . 177, 1 .21 0, 1 .241 , 1 .270,  1 ,297,  1 .325, 1,351,1  .376,  1,401  WAT  00420 

3,  1  ,423, 1  .443, 1.461,1  .476, 1  .480, 1  ,487,  1.500,1.511,1.521,1.531  WAT  00430 

4,  1  .539, 1  .545, 1  ,549, 1.551,1.551,1  .546,1  .536, 1  ,527, 1  ,522, 1.519  WAT  00440 

5,  1  .522, 1.530,1.541,1  ,555, 1  .587, 1.703,1.821,1  .886, 1  ,924, 1  ,957  WAT  00450 

6,  1 ,966,2,0  04,2.036,2,056,2. 069,2.081,2. 094, 2,1  07,2.119,2.130  WAT  0  046  0 

7  /  MOT  0  047  0 


DATA  NSUBI/1 . 1 OE-7 , 4 , 90E-8, 3 . 35E-8 , 2 . 35E-8, 1 ,60E-8, 1 . 08E-8, 6 . 50E-9WHT004e0 

1 ,  3,50E-9, 1 .86E-9, 1 .30E-9, 1 . 02E-9, 9 . 35E-1 0,1. OOE-9, 1 .32E-9, 1 . 96E-9WAT 0 0490 

2,  3.60E-9, 1 . 09E-8, 1 .39E-8, 1 . 64E-8 , 2 . 23E-8, 3 . 35E-8 , 9 . 1 5E-8 , 1 . 56E-7WAT 0 05 0 0 

3,  1 ,48E-7,1 .25E-7,1 . 82E-7 , 2 . 93E-7 , 3 . 9 1 E-7 , 4 . 86E-7 , 1 , 06E-6, 2 . 93E-6WAT0051 0 

4,  3.48E-6,2.89E-6,9.89E-6, 1 . 38E-4 , 8 . 55E-5, 1 , 15E-4, 1 . 1 OE-3, 2 , 89E-4WAT 00520 

5,  9.56E-4,3. 17E-3,6.70E-3, 1 . 90E-2 . 5 . 90E-2 , 1 . 15E-1 , 1 .85E-1 , 2 . 68E- 1 WAT00530 

6,  2 ,98E-1 ,2 , 72E-1 ,2 .40E-1 , 1 ,92E-1 , 1 .35E-1 ,9.24E-2,6 . 1 OE-2 , 3 . 68E-2WAT 0 054 0 

7,  2. 6  IE-2,  1  .95E-2, 1  . 32E-2, 9 . 40E-3, 5 . 1 5E-3, 3 . 60E-3, 3 . 40E-3, 3 . 80E-3WAT00550 

8,  4 .60E-3,5 ,62E-3,6,88E-3,8,45E-3, 1 . 03E-2, 1 .34E-2, 1 .47E-2, 1 . 57E-2WAT 0 056 0 

9,  1  .50E-2, 1  .37E-2, 1  .24E-2, 1  . 1  IE-2, 1  . 0 1 E-2, 9 , 80E-3 , 1  . 03E-2, 1  .  1 6E-2WAT 0 057 0 
X,  1  .42E-2,2. 03E-2,3.30E-2,6,22E-2, 1  . 07E-1 ,1  .31E-1 , 8 . 80E-2 , 5 . 7 0E-2WAT 0 0580 

1 ,  4.49E-2,3.92E-2,3.56E-2,3.37E-2,3.27E-2,3.22E-2,3.20E-2,3.20E-2WAT00590 

2,  3.21E-2,3.22E-2,3.24E-2,3,26E-2,3.28E-2,3,31E-2,3.35E-2,3.39E-2WAT00600 

3,  3 .43E-2,3.51E-2,3 .61E-2,3 .72E-2,3.85E-2,3 .99E-2,4 , 1 5E-2 , 4 . 33E-2WAT 0 06 1  0 

4,  4.54E-2,4.79E-2,5. 08E-2,6.62E-2,9.68E-2, 1  .42E-1 , 1  ,99E-1 , 2 , 59E- 1  WAT  0 062 0 

5,  3 . 05E-1 ,3.43E-1 ,3. 70E-1 ,3.88E-1 ,4. 02E-1 ,4. 1 4E - 1 , 4 . 22E- 1 , 4 , 28E- 1  WAT  0 063 0 

6,  4.29E-1 ,4,29E-1 .4.26E-1 ,4.21E-1 ,4. 14E-1 ,4. 04E- 1 ,3,93E-1 , 3 . 82E- 1  WAT  0 064 0 

7,  3,73E-1 ,3.67E-1 ,3.61E-1 ,3.56E-1 ,3.50E-1 ,3.44E-1 ,3.38E-1 , 3 . 33E- 1  WAT  00650 

8,  3.28E-1 ,3.24E-1 ,3,29E-1 ,3.43E-1 , 3 . 61 E- 1 , 3 . 85E- 1 ,4 . 09E-1 , 4 . 36E- 1 WAT00660 

9,  4.62E-1 ,4,88E-1 ,5, 14E-1 ,5,87E-1,5.76E-1 ,5,47E-1 ,5.36E-1 ,5.32E-1WAT00670 

X,  5.31E-1 ,5.26E-1 ,5. 14E-1 , 5 . OOE-1 , 4 . 95E-1 , 4 . 96E- 1 , 4 . 97E- 1 , 4 . 99E- 1  WAT  0 0680 
1,  5. OlE-1 ,5. 04E-1/  UAT00690 

ALTERNATE  FORM  OF  ABOVE  DATA  STMT  DUE  TO  EXCESS  CONTINUATION  CAROS  WAT00700 
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1 . 

3, 

4. 

5. 

6, 

7  . 

e, 
9, 
X 
1 , 
2. 

3, 

4, 

5, 

6, 


DhTh  <NSUei< I  1  =  1 , t43> 

/t . t0E-7,4.90E-8>3.35E 
,  3 .50E-9, 1 .86E-9, 1 .30E-9, 1 , 02E-9 
3.eOE-9, 1  . 09E-8, 1  .39E-8. 1  .64E- 
25E-7, 1 .82E-7,2.93E- 
89E-6, 9 .89E-6, 1 
17E-3,6.70E-3, 1 
72E-1 ,2.40E-I , 1 
95E-2, 1 .32E-2,9 


.48E-7, t . 
.48E-6.2. 
.56E-4,3, 
.99E-1 ,2. 
.61E-2, 1 


1 

3 
9 

2 
2 

4,6  0E-3,5.62E-3,6.88E-3'.  8 
1 .50E-2. 1 .37E-2, i .24E-2, 1 
1 .42E-2,2. 03E-2,3.30E-2,6 
4 . 49E-2 , 3 . 92E-2 , 3 . 56E-2 , 3 
3.21E-2,3,22E-2,3.24E-2.3 
3.43E-2.3.51E-2,3  -  - 

4.54E-2,4,79E-2,5 
3 . 05E-1 ,3 .43E-1 .3 
4,29E-1 ,4.29E-1.4 
3.73E-1 ,3.67E-1 ,3 


38E- 
90E- 
92E- 
40E- 
45E- 
1  1E- 
22E- 
37E- 
26E 

61E-2,3.72E- 
08E-2,6.62E 
70E-1 .3.88E- 
26E-1 ,4 .21E- 
61E-1 ,3.56E-1 


8,2.35E- 
,9.35E-1 
8,2,23E- 
7,3.91E- 
4.8.55E- 
2,5.90E- 
I , 1 .35E- 
3 . 5 , 1 5E 


8,  I 
0,  1 
8,3 


,6  0E 
OOE 
35E 


-3,  1 
-9 , 1 
-8,9 
-7,  1 
4,  1 
-1  ,  1 
-2,6 


08E- 

32E- 

15E 

06E- 

1  OE- 

85E- 

1  OE- 


<NSUBI<  I  J,  1  =  144, 169) 

,  28E-1 ,3.24E-1 ,3.29E-1 ,3,43E- 
.  62E-1 ,4 ,88E-1 ,5 , 14E-1 ,5.87E- 
.  31E-1 ,5.26E-1 ,5. 14E-1 ,5. OOE- 
.  01E-1 ,5. 04E-1/' 

TEMP, ■’273  .  ,  278  .  ,  283  .  ,  288  .  ,  293 
0.999841 , 0.999965,0,999700,0 
0.995994/ 


7,4.86E 
5, 1 . 15E 
2, 1 . 15E 
1 ,9.24E 

3,3.60E-3;.3.40E 
3, 1 , 03E-2, 1 .34E-2, 1 , 47E- 
2, 1 , 01E-2,9.80E 
2. 1 .07E-t , 1 .31E 
2,3.27E-2,3.22E 
2,3.28E-2,3.31E 
2,3.85E-2,3.99E-2,4 
2,9 .68E-2, 1  ,42E-1  ,  1 
1,4. 02E-1 ,4 . 14E-1 ,4 .22E- 
1 ,4. 14E-1 ,4. 04E-1 ,3.93E- 
,3.50E-1 ,3.44E-1 ,3.38E-1 


3, 1 . 03E- 
1 ,8,80E- 
-2,3.20E- 
-r?,3.3SE- 
15E- 
99E- 


8,6.S0E 
9, 1 .96E 
8,1. 56E 
6,2.93E 
3,2.89E 
1 ,2.68E 
2,3,68E 
3,3.S0E 
,57E 
16E 


,  1 
2,  1 
2,5.70E 
2,3.20E 
2,3.39E 
2,4.33E 
1 ,2.59E 
1 ,4.28E 
1 ,3.82E 
,3,33E- 


1 ,3.61E-1 ,3,85E-1 ,4. 09E-1 ,4.36E 
1 ,5.76E-1 ,5.47E-1 ,5.36E-1 ,5.32E 
1 ,4.95E-1 ,4,96E-1 ,4,97E-1 ,4.99E 

,  ,298.  ,303..^,DEHS-'' 

,999099, 0.998203, 0.997044, 


,2.0R.U8VE.GT. 
.303.0)  GO  TO 


200 
1  1 


0  .  OR  .  TMCHLIR  .  LT  .  273  .  OR  . 


1 


2 

3 


D8TA 
8  3 

9,  4 

X,  5 

1  ,  5 

DATA 

1 

2 

EMT=0 . 0 
CAVT=0 . 0 
P0IMT=0 
H=0 

IF  <WAVE.LT. 0 
1  TMCHUR.GT 
BINARY  SEARCH 
L=1 
H=125 

P0INT=<<L■^H)/2> 

TEST=ABS<  LAMBDA<  POINT )-UAVE  > 

IF  ( TEST. LE. 0. 0001  )  CO  TO  4 
IF  < WAVE. GT,LAMBOA< POINT))  GO  TO  2 
H=POINT 
GO  TO  3 
L=POINT-H 

IF  '.L.NE.H)  GO  TO  1 
L=L-1 

INTERPOLATION  ROUTINE 

EMT=NSUBR<  L  )■*<  NSUBR<  L+ 1  )-NSUBR<  L  ) 

1  LAMBDA<L))) 

C A YT=NSUB I  <  L  j-K  NSUB I  <  L-*- 1  )-HSU8 1  <  L 
1  -LAMBDA< L  )  ) ) 

GO  TO  5 

4  CONTINUE 
EMT=NSUBR< POINT) 

CAYT=NSUBI<POINT ) 

SEARCH  TEMP  VS  DENS 

5  IF  <TMCHUR.LT.273 
L=1 
H=7 

6  P=<<L+H)/2) 

TESTT-ABS<  TEMP<  P  )-TI1CHUR  ) 

IF  <TESTT,LE. 0. 0001 )  GO  TO  9 
IF  <TMCHUR,GT.TEMP<P))  GO  TO  7 
H=P 

GO  TO  8 

7  L-P-fl 

8  IF  < L.NE.H)  GO  TO  6 
L=L-1 

RHODEN=DENS<  L  )+<  DENS<  L*  1  >-DENS<  L  )  )*<  TI1CHUR-TEMP<  L  >  >/<  TEMP<  L■^  1  )- 
1  TEMP<  L  > ) 

GO  TO  10 


)*■<  <  UAVE-LAMBDA<  L  >  ),■'•;  LAMBDA<  L-»  1 
)  )4*<  <  WAVE-LAMBDA<  L  )  )/<  LAr1BDA<  L-«- 


0. OR, TMCHUR.GT. 303.0)  GO  TO  11 


WAT007I 0 
-9UAT00720 
-9UAT007‘  0 
-7WAT 00740 
-6WAT00750 
-4WAT00760 
-IWAT00770 
-2WAT 00780 
-3UAT00790 
-2WAT00300 
-2WAT0081 0 
2WAT 00820 
-2WAT00830 
-2WAT 00340 
-2WAT00350 
-1UIAT00860 
1UAT00870 
-1WAT00880 
1/UIAT00390 
WAT00900 
-1  WAT  0  091  0 
-1  WAT  0  092  0 
-1UAT00930 
WAT00940 
WAT00950 
WAT00960 
WAT00970 
WAT  00980 
WAT  0  099  0 
WAT  01 000 
WAT  01010 
WAT01 020 
WATOl 030 
WATOI 040 
UAT01 050 
WAT  0 1 060 
WATOI 070 
WATOI 080 
WAT  01090 
WATOI 1 00 
WATOI 1 1 0 
WATOI 120 
WATOI 130 
WATOI 140 
WAT  01150 
WATOI 160 
>-UAT  CM  170 
WAT  0 )  M?0 
1 >WAT01 190 
WAT  01 2 00 
WAT  01210 
WAT 01 220 
WAT01230 
WAT01240 
WAT01250 
WAT01260 
WAT01270 
WAT01280 
WAT01290 
WATOI 300 
WAT0I31 0 
WAT01320 
WAT01330 
WAT01340 
WAT01350 
WAT01360 
WAT01370 
WAT01380 
WAT01390 
WAT01400 
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9  KHOutN'DENSt P > 

1 0  CONTINUE 
GO  TO  J3 

11  WRITE  <I0UT,12>  TNCHUR.WRVE 

12  FORMAT  Cl  OH  TEMP.  OF  ,EI2.6,14H  OR  WAVEL .  OF  , 
IGE  ,24H0F  DATA  IN  WATER  R0UTINE/'22H  EXECUTION 

STOP 
RETURN 
END 


t 


3 


1 1 


SUBROUTINE  CAUS<1T> 

COMMON  /PT5:/  PC<  65  ) ,  OL<  65  > ,  RMS<  65  > ,  PSUM<  65  > ,  PSUMTC  65  ) .  P<  65  > 
COMMON  /lO/  lOlN, IOUT,NUNIT, lEO.NEOU 
COMMON  /AGXM/  C< 65 > , W< 65 > , OLTC 65  ) , JO IMCK< 3 > 

WRITE  < lOUT, 1 1  ) 

INITIALIZE  ARRAY  PC<  >  USED  FOR  RUNNING  SUMMATION 
DO  1  1  =  1, IT 
OL< I >«0. 

PC< I >=0 . E+  00 

LOOPS  2  AND  3  CALCULATE  EXPANSION  CuEFS.  FOR  FUNCTION  PSUM< 
VIA  CAUSS-LEGENDRE  QUADRATURE.  THE  COEFS.  GO  INTO  ARRAv  OLc  .) 
DO  3  1=1 , IT 
COF«W(  I  )>*PSUM<  I  > 

PLM1 =C< I  ) 


PLM2=1 
DO  2  LL 
L*LL-1 
PL=PLM2 
IF  <LL.EQ 
IF  <LL.LE 


1  ,  IT 


2>  PL=PLM1 

_ 2  >  GO  TO  2  _  .  .  _ 

PL  =2  .  ’►Ct  I  >*PLM1  -PLM2-<  C<  I  >=PLM1  -PL M2  )/FLOhT'.  l.  ) 
PLM2=PLM1 
PLM1 =PL 

OL( LL  >=OL<  LL  >+COF*PL*<  FLOAT<  L  )+ -  5  ) 

CONTINUE 
DO  7  1=1 , IT 
H  =  I-1 

WRITE  < I0UT,8>  II,OL< I > 

FORMAT  <1H  ,20X, I6,20X, 1PE14.7) 

FORMAT  <1H  /, 1X,25X, 1HL,20X, 16HL-TH  COEFFICIENT) 

RETURN 

END 


GAUS001 0 
GAUS0020 
GAUS0030 
GAUS0C40 
GALIS005  0 
GAUS0060 
GAUS0070 
GAUS0080 
GAUS0090 
GAUS01 00 
GAUSOi 1 0 
GAUS01 20 
GAUS0130 
GAUS0140 
GAUS0t5u 
GAUSOI 60 
GAUS0170 
GAUSOi 80 
GAUSOiSO 
GAUS0200 
GAUS021 0 
GAUS0220 
GAUS0230 
GAUS0240 
GAUS0250 
GAUS0260 
GAUS0270 
GAUS0280 
GAUS0290 
GAUS0300 
GAUS031 0 
GAUS0320 
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SUbkOUTIHE  DIMER<.'NG0> 

COMMON  <^10,-'  lOIN,  lOUT.HUNIT,  IEO.NEOU 
GO  TO  < 1 ,2,3),NG0 

1  WRITE< I  OUT, 101) 

101  FORMAT';  1H  ,  THE  INPUT  VALUE  OF  IT  IS  GREATER  ' 

1,'THAN  THE  ARRAY  D I  MENS  I ONS  '  , / ,  '  CHANGE  THE  DIMENSIONS  OF  THE 
2 'FOLLOWING  ARRAYS  IN  SUBS  AND  COMMON 'COMMON  BLOCK', 1  OX, 

3 'ARRAYCS  )  ' , X,  '  AGXM',10X,'  C,H,OLT',/,'  PT2',11X, 

4'PC, OL, RMS, PSUM,PSUMT,P',X,  'ALSO  CHANGE  THE  VALUE  OF  JIMCK< 1  )  ' 

5,  'IN  THE  DATA  STMT  TO  AGREE  WITH  THE  NEW',/','  DIMENSION  LIMITS', 
6/,1H  ,55HTHE  SECOND  INDEX  ON  ARRAYS  PI,  TAU,  AND  ELTRMX  IN  MIEGX 
7,1H  ,56HMUST  ALSO  BE  CHANGED  AND  ARRAYS  P  AND  C  CHANGED  AS  WELL.) 

STOP 

2  WRITE  <  TOUT, 1 02) 

102  FORMAT<1H  ,'*■*•♦*  TOO  MANY  PARTICLE  RADII  FOR  DIMENSION  LIMITS:', 
1'IN  SUBS  AND  COMMON  CHANGE  THE  FOLLOWING  ', 

2'ARRAVS',X,  'COMMON  BLOCK', 1  OX ,  '  ARRAYC S  )  ' , / ,  '  PT 1  '  , 1 1 X ,  '  F , R , FF  ' 

3/, 'ARRAYS  F  AND  R  MUST  BE  CONSISTENT  WITH  THE  FOLLOWING:  ARRAY  ', 
4'SI2E  =  1  +  2‘i»fJDIMCK<2)',/,  'ARRAY  FF  MUST  BE  DIMENSIONED  TO  ONE' 
5'  MORE  THAN  ARRAYS  F  AND  R',/','ALSO  CHANGE  THE  VALUE  OF  JDIMCK':2) 

6, '  IN  THE  DATA  STATEMENT') 

STOP 

3  WRITE  <  TOUT, 1 03  ) 

103  FORMAT  <1H  ,'  THE  DIMENSIONS  OF  F  AND' 

1,'R  DO  NOT  AGREE  WITH  THE  FOLLOW  I NG  :  ' , /',  '  3 12E  =  1 +2t"*‘ JD I  MC.K<  2  >  ', 
2'WHERE  JDIMCK(2)  APPEARS  IN  THE  DATA  STATEMENT AL SO  DIMENSION 
3.  '  ARRAY  FF  TO  BE  ONE  MORE  THAN  ARRAYS  F  AND  P') 

STOP 

END 


D I M  ;i  0  0 1  0 
DIM00020 
DIM00030 
DIM00040 
DIM00050 
DIM00060 
DIM00070 
DIM00030 
DIM00090 
D I M  0  0 1  0  0 
DIM0C1 1 0 

d:mooi20 

DIM00130 
D I M  0  0  i  4  0 
DIM00150 
DIM001 60 
,  D I M  0  Cl  1  7  0 
DIM001S0 
,  D I M  0  0 1  9  0 
'DIMOnSOO 
DIM0G21 0 
DIM00220 
DlriuOC'ju 
DIM00240 
DIM0U250 
'DIM00260 
DIM00270 
DIM00280 
DIn0u290 


0 
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6L.0CK  OATh 

IF  YOU  CHANGE  THE  OIHEHSIONS  MAKE  SURE  THAT  YOU  ALSO  CHANGE  THE 
DATA  STATEMENT  CONTAINING  JDIMCk<  >: 

J[)IMCK<  1  )=ORDEk  of  quadrature  <  INPUT  1T),I.E.  MAH  SIZE  OF  DIMENSI 
JDIMCK< 2 > : USED  IN  COMPUTATION  OF  SIZE  OF  ARRAYS  F  AND  R, 
3I2E=1+2+*JDINCK<2 >,  ARRAY  FF  SHOULD  BE  ONE  MORE  THAN  F  AND  R, 
JIMCKCS)  WILL  BE  CALCULATED. 

THE  OTHER  ARRAYS  ARE  REUSED,  SO 

CHECK  THE  SUBROUTINE  CALLS  AND  COMMON  BLOCKS  TO  SEE  IF 
ARRAYS  HAVE  BEEN  RENAMED  WHEN  U  CHANGE  DIMENSIONS, 

COMMON  HAGHMH  C< 65 > , W< 65  ) , OLT< 65 > , J01MCK< 3 > 

COMMON  /PT1H  F<513),R<513),DR':8),RR<9>,FF<514) 

+,NRAD1,PI, IDSTP,NKG,NHALV,NI 

COMMON  HPT2/  PC< 65  ) , OL< 65  ) , RM3< 65 > , PSUM< 65 > , PSUMT< 65 > , P< 65 > 

COMMON  /lO/  I0IN,10UT,HUHIT, IEO,NEOU 
DATA  lOIN,  IOUT,HUNIT,  IEO,NEOU  /’5,6,3*0/ 

DATA  JDIMCK  /’6S,9,0/ 


EOSAEL  OPTION; 
DATA  w 


65  PREDETERMINED  ANGLES 


H  0,0,  0.5, 

1  .  0, 

2.0,  3.0, 

4.0,  5.0, 

6.0, 

8.0, 

10.0 

+ 

12.0,  14.0, 

16.0, 

18.0,  20.0, 

24.0,  28,0, 

32 . 0, 

36. 0, 

40. 0 

+ 

44.0,  48.0, 

52 . 0, 

56.0,  60.0, 

64. 0,  68, 0, 

72 . 0, 

76 , 0, 

80. 0 

84.0,  88.0, 

92.0, 

96.0,100.0, 

104.0,103.0, 

112.0, 

116.0, 

120.0 

124. 0,128. 0, 

132.0, 

136.0, 140. 0, 

142. 0, 144, 0, 

146.0, 

148,0, 

150.0 

+ 

152.0, 154. 0, 

156.0, 

158.0,160.0, 

162.0,164.0, 

166.0, 

168.0, 

170.0 

+ 

172. 0, 174, 0, 

176.0, 

178.0,180,0/ 

END 


BLKuOOl 0 
BLKOC020 
BLK0003 
CrBLK0  0  04  0 
BLK00050 
BLK00060 
BLK00070 
BLK  0  0  080 
BLK00050 
BLK001 00 
BLK 001 1 0 
BLK00120 
BLK00130 
BLK001 40 
BLK001 50 
BLK001 60 
BLK 001 70 
BLK00180 
BLKuOl 90 
BLK 002 00 
BLK 0021 0 
BLK00220 
BLK00230 
BLK00240 
BLK00250 
BLK00260 
BLK00270 


41  0 


PROGRAM  t-LASHI 
C0MM0N<'‘I0UNT/’I01N,  luOUT 
COMMON/COHST/Pl 

C0MM0N/IDftTA,-'R0BS<3i,RTAR<  3).TARDEG,RSRC<3),TIMCUH,FDV.WAVE, 
f  RADSEE,  RADLOC,TftRLEH,TARtillD.TAPHGT,PCTSEE.PCTLOC, 

*  TIME, ISRC.RCTSEE.RCTLOC 

Pl=3. 14159 
IOlN=5 
IOuUT=b 

C****  NOTE  ICHK>-1  DEFAULTS  USETR  INPUT  TO  WAVEl 
ICHk=0 
WAVE  1 f . 35 

CALL  i-LAbH<  WAVEl  ,  ICHi<  > 

WRITE  <IOOUT,100>  WAVEl , ICHK 
100  FORMAT  <5X, 13HE0SAEL  OUTPUT,/, 

*5X, 1 3HWAVELENGTH  =  , F6 . 1 , 1 X , 1 1 HM I CROMETERS , / , 

*5X,  7HIC.HK  =  ,  14  ) 

STOP 

tND 


DRI V001 0 
ORIV0020 
DRIVOOSO 
DRIV0040 
DRIVOOSO 
DRIVOOSO 
DRI  VCi07  0 
DRI vOOau 
DRIVOOSO 
DRIvul 00 
DR 1 V  0 1 1 0 
DRI V  0 i 2  0 
DRIV0130 
DRIV0140 
DRIV0150 
DRIV0160 
DR.IVOI  7  0 
DR I V  018  0 


noon 


/ 


SUBPOUTIHE  FLASH<WhVE1 , ICHk>  FLASH010 

«  «>«<«*  «>*>><<*«>)<>«•>«<  <(<sti  Hi  >)■  <•■>*«  III  *  I»1«|  Id  >t<  *  >k  4i  %  If  It. «  .1, 4, ««« <|i  41  *4<  >•<*«<«■  >ti  «>*  X<  >t<  4:  F  L  P  S  H  0  2  0 

PkOuRhM  FLftSH  *FLhSH03 

EOSrtELBO  *FLhSH04u 


4.4<4i4<4<4i4<4.4<4<4>4<4<>«<4<4i4i4i4i>«>4>4i4<4<4i4i4i4ii|i4i4i*4i4i4i4<4<*4i4>4i4<4<4i4i4i>l<4<4i4<«4i4i4<4>«4<4i4i4i4i4i«>«i><<4i4<4ii<i4<4iFLHbH05  0 
DIMEHSIOH  FLASH1<3>iFLPSH2<3>i  IC1  <  3  >,  1C2<:  3  IGUH<3>  FLhSH060 

COMMON^'IOUMT/IOIN,  lOOUT  FLASH070 

COtlMON/CONSTi^PI  FLASHOSO 

COMMON/*  ID  AT  A/ROBS<  3  > ,  RTAR<  3  '} ,  TARDEG,  RSRCt  3  i,  T IMCUN^  FOV ,  WAVE ,  FLA3H09U 

♦  RADSEE,RADLOC.TARLEN,TARUlD,TARHGT,PCTSEE.PCTLOCi  FLASHIOO 

^  TIME,  ISRC.,RCTSEE,RCTLOC  FLASH110 

DATA  FLASH1,^3.85,2 .55,  0.  0/*  FLASH)20 

DATA  FLASH2/’0.  15,  0.  15,  0.  0/  FLASH130 

DATA  1C1.'’2HH0,2HT-,2HUN/  FLASH140 

DATA  IC2/’2HU.  ,2H55.2HKN/  FLASH150 

DATA  IGUN/I 05, 1 00, 0/  FLASH160 

98  FORMAT<//,21X,3  0Ht'>*<=«<>»*PROGRAM  FLASH  OUTPUT+ffH-* ,  / ,  2 1  X ,  40<  2H — >)  FLASH170 

99  FORMAT<21X,20H*****END  OF  RUN***** ,  ,-* ,  2 1 X ,  40<  2H — >>  FLASH18C 

100  FORMAT<  1H1 ,20X,40<  2H**  ), /’,21  X,  1H*,34X,  13HPR0GRAM  FLASH ,  3 1  X ,  1  H* , /* ,  FLASH190 


*21 X, 1H*, 37X,8HEOSAEL80,33X, 1 H* , / , 21 X , 40< 2H**  )  > 

1  01  FORMAT<  /'X,21X,  1  5H***** INPUT***** , 2 1  X,  40<  2H--  >) 

102  F0RMAT<21X, 14HSCENARI0  DATA i , X , 2 1 X, 1 4HREFERENCE  T IME , 1 X , F8 . 3 , 

*  1 X  3HSEC  ) 

1 03  F0RMAT<21X,9H0eSERVERi , 1 8X, 7HTARGET s , 20X, 7HS0URCE : ) 

104  FORMATS  24X,  6HX<r  OBS  ),  3X,  F6. 1 ,2H  M ,  1  OX ,  6HX<  TAR  ) ,  3X ,  F6 . 1  ,  2H  M,10X, 
*6HX<SRC),3X,F6. 1 ,2H  M,X, 

*  24X,6HY<0BS),3X,F6. 1  ,2H  M,  1  OX,  6HY'' TAR  >,  3X,  F6 . 1 , 2H  M,10X, 
*6HY<SRC),3X,F6. 1 ,2H  M,X, 

*  24X,6H2<0BS),3X,F6. 1 ,2H  M, 1  OX, 6H2< TAR >, 3X , F6 . 1 , 2H  M, 1  OX, 
*6HZ<SRC),3X,F6. 1 ,2H  M) 

1 05  F0RMAT<48X, 1 1HORIENTATION, IX, F6. 1 , 1 X, 3HDEG , 8X, 

*1 OHEVENT  TIME, 1X,F6,3, 1 X , 3HSEC , X , 67X, 

*10HCCW  X-AXIS) 

106  F0RMAT<21X,25HDETECT0R  CHARACTERISTICS :, X, 

*  24X,13HF1EL0  OF  VIEW, 1 2X, F6 . 1 , 1 X, 7HDEGREES, X , 

*  24X, 1 OHWAVELENGTH, 15X,F6, 1 , IX, IlHMICROMETERSiX, 

*  24X,21HRES0LUTI0N  CRITERIA — ,X, 

*  26X,17H<A)  FOR  DETECTION, 6X , F6 . 3, 1 X, 1 2HMILL IRADIANS, X , 

*  26X,15H<B)  FOR  LOCK  ON, 8X, F6 . 3, 1 X, 1 2HMI LL IRADIANS , X, 

*  24X,24HREC0VERY  TIME  <R=10CM>— ,X, 

*  26X,17H<A)  FOR  DETECT  ION , 6X , F6 . 1 , 1 X . 7HSEC0NDS , X , 

*  26X,15H<B)  FOR  LOCK  ON , 8X , F6 . 1 , 1 X, 7HSEC0NDS  ) 

107  FCiRMAT<21X,23HTARGET  CHARACTERISTICS  J  ,  X, 

*  24X,6HLENGTH, 19X,F6, 1 , 1 X , 6HMETERS, X , 

*  24X,5HWIOTH,20X,F6. 1 , 1 X , 6HMETERS, X , 

*  24X , 6HHE I GHT , 1 9X , F6 . 1 , 1 X , 6HMETERS , / , 

*  24X, 19HEXP0SURE  CRITERIA — ,X, 

*  26X,17H<A)  FOR  DETECTION , 6X, F6 . 1 , 1 X , 7HPERCENT , X , 

*  26X,15H<B>  FOR  LOCK  ON , 8X, F6 . 1 , 1 X, 7HPERCENT > 

103  F0RMAT<2tX,23HS0URCE  CHARACTERISTICS :, X , 

*  24X,4HTYPE,22X, I4,2HMM, 1X,2A2,X, 

*  24X,22HFLASH  <VISIBLE)  RADIUS, 4X,F6 , 3, 1 X, 6HMETERS, X, 

*  24X,24HFLASH  <VISIBLE)  DURATION, 2X, F6 . 3 , 1 X , 7HSEC0NDS  ) 

109  F0RMAT<24X,27H*****PR0GRAM  FLASH  END*****,  X,  2 1 X,  40< 2H — ),1H1) 

1WRIT=1 

IFLAG=0 

C*****READ  IN  DATA 

1  WRITE< lOOUT, 100) 

CALL  DATRD< IWRIT, IFLAG) 

1 F< I CHK , EQ . - 1 )WAVE*WAVE 1 
UAVE1-UAVE 

IF< IFLAG.EQ.4>G0  TO  9999 
JSRC=1SRC 

IF< ISRC.LT. 1 .OR, ISRC.GT.2)JSRC-3 
FLASHR-FLASH1 <  JSRC  > 

FLASHT-FLASH2<  JSRC  ) 

WftITE< lOOUT, 1 01  ) 

WRITER lOOUT, 1 02  )TIME 
UR1TE< lOOUT, 1 03) 

WRITE<  lOOUT,  1  04  )<  ROBS<  I  ),RTAR<  I  ),RSRC<  I  ),  I»1 ,3) 


FLASH200 
FLASH21 0 
FLASH220 
FLASH230 
FLASH240 
FLASH250 
FLASH260 
FLASH270 
FLASH280 
FLASH290 
FLASH300 
FLASH31 0 
FLASH320 
FLASH330 
FLASH340 
FLASH35C 
FLASH360 
FLASH370 
FLASH380 
FLASH390 
FLASH400 
FLASH41 0 
FLASH420 
FLASH430 
FLASH440 
FLASH450 
FLASH460 
FLASH470 
FLASh  QQ 
FLASh490 
FLASH500 
FLASH51 0 
FLASH520 
FLASH530 
FLASH540 
FLASH550 
FLASH560 
FLASH570 
FLASH580 
FLASH590 
FLASH600 
FLA3H61 0 
FLASH620 
FLASH650 
FLASH64G 
FLASH650 
FLASH660 
FLASH670 
FLASH680 
FLASH690 
FLASH700 
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URITE<  lOOUT,  \  05  >ThRDEG.,TIMGUN 

URITE< lOOUT, 1 06 )FOV , WAVE , RADSEE , RAOLOC . RCTSEE , RCTLOC 
URITE< lOOUT,  1 07  HARLEN, TARWID , TARHGT , PCTSEE , PCTLOC 
URITE<  lOOUT,  J  08>IGUN<  JSRO,  ICU  JSRO,  1C2<  JSRC  J ,  FLASHR ,  FUASHT 
CALL  GETIM<FLASHR,FLASHT, ISTOP, ISEE, ILOC , T IMLEF , T I MNOL  ) 
UP1TE< lOOUT, 98 > 

CALL  DATWT< ISTOP, ISEE, ILOC, TIMLEF, TIMNOL i 
WRITE< I00UT,99> 

GO  TO  1 

9999  WRITE< lOOUT. t 09i 
c*h<»^>«define  eosael  output 
ICHK=ISEE+1 
5TuP 


END 


FL  iSH71  0 
FLASH720 
FLASH730 
FLACH740 
FLASH750 
FLASH760 
FLASH770 
FLASH780 
FLASH790 
FLASH800 
FLASH81 0 
FLPSH920 
FLASh83o 
FLASHS40 


4<3 
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SUBftOLITIME  DhTRD<  lURIT,  IFLAO  DTROOulO 

C/*  SUBROUTINE  DATRD  ♦/DTRuOO’u 

C2*  FLASH  MODULE  ■*,-’DTRD0040 

C/*  EOShELBO  k/DTRl'OOSu 

C***>*'*THIS  SUBROUTINE  READS  INPUT  DATA  IN  EXACTLY  THE  SAME  FORMAT  AS 


THE  SMOKE<EOSAEL >  AND  GRNAD< EOSAEL >  MODULES 
INPUTS 

EACH  CARD  BEGINS  WITH  A  4  LETTER  IDENTIFIER  IN  COL  1-4, 
FOLLOWED  BY  AS  MANY  (REAL)  FIELDS  AS  NEEDED.  10  COL. 

PER  FIELD  BEGINNING  IN  COL  11.  THE  CARDS  ARE  NOT  ORDER 
DbPENDENT . 

IGNORtD 

SCENARIO  REFERENCE  TIMEcSEC) 

SOURCt  TYPE  CODE  (1=*105MM  2=luOMM> 

OBSERVER  COORDINATES  <X,Y,2  METERS) 

TARGET  COORDINATES  <X,Y.2  METERS) 
TARGET  ORIENTATION  COUNTERCLOCKWISE  TO 
POSITIVE  X  AXIS 


DTRD0u7u 
DTRDOuSO 
DTRDOOSO 
DTRDul 00 
DTRDOl 1 0 
DTRD0120 
DTRDOl 30 
DTRD  0 1 4  0 
DTRDOl sO 
DTRDOl 60 
DTRDOl 70 
DTRDOl 80 
DTRDOl SO 

DTRD02no 

DTRD  02 1 0 
DTRD0220 
D  I  RDu2.iO 
DTRD0240 

CORDINATES  OF  FLASH  CENTER  (X,Y,2  METERS  >DTRD  02t)  0 
TIME  OF  INIATION  OF  GUNFLASH  DTRD0260 

DTRD 02  c  0 

DETECTOR  FIELD  OF  VIEW  (DEGREES)  DTRD02SO 

DETECTOR  WAVELENGTH  (MICROMETERS)  DTRD0290 

ANGULAR  RESOLUTION  NEEDED  TO  DETECT  DTRD0300 

(MILLIRADIANS)  DTRD0310 

ANGULAR  RESOLUTION  NEEDED  TO  LOCK  ON  DTRD 0320 

(MILLIRADIANS)  DTRD0330 

RECOVERY  TIME  AT  100  METERS  FOR  DTRD0340 

DETECTION  (SECONDS)  DTRD0350 

RECOVERY  TIME  AT  100  METERS  FOR  DTRD0.360 

LOCK  ON  (SECONDS)  DTRD 0370 

DTRD 0380 

TARGET  LENGTH  (METERS)  DTRD 0390 

TARGET  WIDTH  (METERS)  DTRD0400 

TARGET  HEIGHT  (METERS)  DTRD0410 

FRACTION  OF  EXPOSURE  HEEDED  FOR  DETECTIONDTRD0420 
(PERCENT)  DTRD0430 

FRACTION  OF  EXPOSURE  NEEDED  FOR  LOCK  ON  DTRD0440 
C  (PERCENT)  DTRD0450 

C  GO  SIGNIFIES  END  OF  THIS  RUN,  BUT  HOT  END  OF  INPUT  DTRD0460 

C  DONE  END  OF  JOB.  DTRD 0470 

COMMON/IOUNTXIOIN, lOOUT  DTRD0490 

COMMON/ 1 DATAXROBS( 3  ),RTAR<  3 ) , TARDEG , RSRC<  3 ) , T 1 MGUN , FOV , WAVE ,  DTRD 05 0  0 

*  RAOSEE,RAOLOC,TARLEN,TARWlD,TARHGT,PCTSEE,PCTLOC,  DTRD0510 

f  TIME, ISRC,RCTSEE,RCTLOC  DTRD0520 

DIMENSION  1R<  18),  IRt(2),R1(7),  IHAME<35)  DTRD0530 

DATA  I R/2HNA , 2HME, 2HSC , 2HEN , 2H0B , 2HSC, 2HTA, 2HRC , 2HSR , 2HCC ,  DTRD054 0 

♦  2HDC,2HHR,2HTC,2HHR,2HG0,2H  ,2HD0,2HNE/  DTRD0550 

100  FORMAT(21X,20H*****CARD  INPUT*-*-*** ,  / ,  21 X,  40(  2H— )  )  DTRD0560 

101  F0RMAT(2A2,6X,7FI 0.3)  DTRD0570 

102  F0RMAT<21X,2A2,6X,7FI 0.3)  DTRD0580 

103  F0RMAT(2A2,6X,35A2)  DTRD0590 

104  F0RMAT(21X,2A2,6X,35A2)  DTRD0600 

C%>K«**  DTRD0610 

BEGINNING  OF  READ  LOOP  DTRD0620 

C*****  DTRDu630 

IF( IWRIT.EQ. 0>GO  TO  6  DTRD0640 

WRITE( iOOUT, 1 00)  DTRD0650 

6  DO  10  1=1,9  DTRD0660 

1F<I.EQ.9)G0  TO  90  DTRD0670 

1F( IFLAG.GT. 0)GO  TO  4  DTRD0680 

IFLAG=1  DTRD0690 

READdOlN,  103>IR1(  1  ),IR1(2>,<  INAME(  J  ),  J-1 , 35  )  DTRD07  0  0 


c 

c 

c 

c 

NAME 

SCtN 

TIME 

ISRC 

c 

OBSC 

c 

R0BS(3) 

c 

c 

TARC 

kTAR( 3  ) 

c 

TARDEG 

c 

c 

c 

SRCC 

RSRC( 3  ) 

c 

c 

DCHR 

TIMGUN 

c 

FOV 

c 

WAVE 

c 

RADSEE 

c 

c 

RADLOC 

c 

C 

RCT3EE 

L 

c 

RCTLOC 

c 

c 

TCHR 

c 

TARLEN 

c 

c 

TARWID 

TARHGT 

c 

PCTSEE 

c 

c 

PCTLOC 
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IF<1URIT.EG. 0>GO  TO  A 

WRITE< lOOUT, 1 04  >rR1< 1  IRl < 2 > , < INrtHE<  J ), J=1 ,35) 
READ<  IOIN,»01)  IR1<1),IRK2),<Rt<J>,Ja1,7) 

IF< IWRIT .EQ. 0  )  GO  TO  5 

URITE< lOOUT, 1 02)  IR1 < 1  ) , IR 1 < 2 >, < R 1 < J ), J= 1 , 7  ) 

IF<  IRK  1  >.EQ.  IR<  17>,AND.  IR1<2).EQ.  IR<  18)>  GO  TO  998 


5  IF<  IRK  1  >.EQ.  IR<  1  7  )  ,  AND  .  I R  K  2  )  .  EQ  .  IR<  1 

Q  4(  4(i4t 

C***  RELATING  INPUT  DATA  TO  VARIABLE  NAMES. 
^ 

IF<  IRK  1  ).EQ.  IR<  1  ).AND.  IRK2).EQ. 
IF<  IRK  1  ).Ee.  IR<3).  AND.  IRK2).EQ. 
IF<  IRK  1  ).EQ.  IR<5>.AHD.  IRK2).EQ. 
IF<  IRK  1  ).E0.  IR<7).AND.IRK2).EQ. 


IF<  IRK  1  ).EQ.  IR<  1  ).AND.  IRK2).EQ.  IR«:2)) 
IF<  IRK  1  ).Ee.  IR<3).  AND.  IRK2).EQ.  iR<4)) 
IF<  IRK  1  ).EQ.  IR<5>.AHD.  IRK2).EQ.  IR<6)) 
IF<  IRK  1  ).E0.  IR<7).  AND  .  IR  K  2  )  .  EQ  .  IR<  a  )  ) 
IF<  IRK  1  ).EQ.  IR<9  ).  AND.  IRK2).EQ.  IR<  10)) 
IFt  IRK  i  )  .  EG  .  IR<  1  i  )  .  AND  .  IRK  2  )  .  Eu  .  iR<  1  2  ) 
IF<  IRK  1  ).EC).  IR<  13).  AND,  IRK  2  )  .  EQ  ,  IR<  1  4  > 


iR<12))  GO  TO 
IR<14>)  GO  TO 


GO  TO  10 
GO  TO  20 
GO  TO  30 
GO  TO  40 
GO  TO  50 
GO  TO  bO 
GO  TO  70 
GO  TO  9999 


IF< IR1 < 1 ) . EQ . IR< i 5 > . AND . IR1< 2 ) . EQ . IR< 1 6  )  )  GO  TO  9999 

Q  t 

C  ERROR  CAUTION  FOR  INVALID  DATA  CARD 

0*1*+** 

iFLAG=2 

WRITER lOOUT, 1 05) 

105  F0RMAT<21X,35H+*x»t<*CAUTI0N**»>t“*-  INVALID  DATA  CARD) 

GO  TO  10 

2  0  TIME=RK  1  ) 

I3RC=IFIX<RK  2  )  ) 

GO  TO  10 

30  ROBS<l>=RK1) 

R06S<  2  )=R  K2  ) 

R0BS<3)=RK3) 

GO  TO  10 

4  0  RTAR<  1  )--RK  1  ) 

RTAR<  2  )=R  K  2  ) 

RTAR<  3 )=R  t  <  3  ) 

TARDEG=RK4) 

GO  TO  10 

50  RSRC< 1  )=R1< 1  ) 

RSRC<2)=RK2) 

RSRC<  3  )=R1<  3  ) 

TIMGUH=RK4) 

GO  TO  10 

60  FOV*RKl) 

UAVE=R1<2) 

RADSEE=RK3) 

RAOLOC=RK  4  ) 

RCTSEE=RK5) 

RCTL0C=RK6) 

GO  TO  1 0 

70  TARLEN=RK1> 

TARWID=RK2) 

TARHGT=RK3) 

PCTSEE*RK4) 

PCTL0C*RK5> 

10  CONTINUE 
GO  TO  9999 

C4*4**CAUTI0N  for  too  manv  cards 

PikifcAiliA 

90  URITE<100UT,106) 

IFLAG-3 

1  06  FORMAT<  21 X,  1 7Hf>*4.4*CAUTIONt<f ***,/', 

*21X,56HM0RE  THAN  10  DATA  CARDS  ENTERED— REMA I NING  CARDS  IGNORED) 
GO  TO  9999 

998  IFLAG>4 
9999  RETURN 
END 


DTRD071 0 
DTRDCt72  0 
DTRD0730 
DTRD0740 
DTRD0750 
DTRD0760 
DTRD0770 
DTRD0780 
DTRD0790 
DTRD0800 
DTRDOSl 0 
DTRD0820 
DTRD0830 
DTRD0840 
DTRDOSsO 
DTRD0S60 
DTRD0S70 
DTRD0880 
DTkD089u 
DTRD0900 
DTRD091 0 
DTRD0920 
DTRD0930 
DTRD0940 
DTRD095U 
DTRD0960 
DTRD097U 
DTRD09S0 
DTRD099U 
DTRDl 000 
DTRDl 01 0 
DTRDl 020 
DTRDl 030 
DTRDl 040 
DTRDl 050 
DTRDl 060 
DTRDl 070 
DTRDl 080 
DTRDl 090 
DTRDl 1 00 
DTRDl 110 
DTRDl 120 
DTRDl 130 
DTRDl 140 
DTRDl 150 
DTRDl 160 
DTRDl 170 
DTRDl 180 
DTRDl 190 
DTRDl 200 
DTRD121 0 
DTRD1220 
DTRDl 230 
DTRD1240 
DTRD1250 
DTRDl 260 
DTRD1270 
DTRDl 280 
DTRDl 290 
DTRD1300 
DTRD131 0 
DTRD1320 
DTRDl 330 
DTRDl 340 
DTRD1350 
DTRDl 360 
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SUBROUTINE  DATWT< I  STOP, ISEE, ILOC, TIHLEF, TIMNOL  >  DmT000( 0 

SUBROUTINE  DATUT  ♦  DrtTOOO'^u 

C*  hLASh_MuDULE  *  DhTO0U‘*0 

O'*  EOStthLSO  DhTOOOSO 

COMHON,'’IOUNT/’IOIN,  10  OUT  DhTOuOTO 

COMMON/ 1 DftTA/ROBS<  3 ),RTAR<  3  > , TARDEG , RSRC< 3 ) , T I HGUN , FOV , WAVE ,  DAT 0  0 08  0 

■*  RADSEE.RADLOC,TARLEN,TARUIO,TARHGT,PCTSEE .PCTLOC,  DAT00080 

■»  TIME,  ISRC,RCTSEE,RCTLOC  DATOOlOO 

DIMENSION  IH3>,I2<3>  DAT00110 

DATA  n/2HN0,2HYE,2HPA/  DAT00120 

DATA  I2/2H  , 2HS  , 2HRT/  DAT00130 

IANS1=ISEE+1  DAT00140 

IFC ISEE.E0.3>IANS1=3  DATDOISO 

IF<  ILOC  .  ECl .  0  >IANS2  =  2  DAT 00160 

IF< ILOC . EQ . 1  >I ANS2=1  DAT  00 170 

IF< IL0C.EQ.2>IANS2=3  DAT00180 

Ih< ILOC . EQ . 0 >I aNS2=2  DAT  00 190 

It-<  ILOC .  EQ ,  3  >I  ANS2=3  _  DAT 0  02 0  0 

82  FORMAT<21X,36HDETECTION  EXPOSURt  CRITERIA  DEFEATED!  DAT002i0 

83  F0RMAT<21X,38HDETECTI0N  RESOLUTION  CRITERIA  DEFEATED!  DAT00220 

92  F0RMAT<21X,34HL0CK  ON  EXPOSURE  CRITERIA  DEFEATED)  DAT00230 

93  F0RMAT<21X,36HL0CK'  ON  RESOLUTION  CRITERIA  DEFEATED!  DAT00240 

97  FORMAT<21X, 17HTARGET  OBSCURED  ?,1X,2A2,/,  DAT00250 

*  21X, 15HTARGET  LOCKED  ?,1X,2A2!  DAT  00260 

98  F0RMAT<21X, 1 OHTIME  LEFT : , 4X , F8 . 3 , 1 X , 7HSFC0NDS , / ,  DAT00270 

*  21X,13HTIME  NO  LOCK i , 1 X , F8 . 3, 1 X, f HSECONDS  !  DAT00280 

99  F0RMAT<21X,25HPR0GRAM  FLASH — STOP  CODE ! , 1 X , 3 1 1  !  DAT00290 

100  F0RMAT<21X, 1 1HSOURCE  TYPE , 1 X , 1 2 , 1 X , 1 2HUN1 DENT  I F I  ED  !  DAT00300 

101  FORMAT<21X, 17HINPUT  WAVELENGTH !, 1 X, F6 , 1 , 1 X , 1 1 HMICROMETERS ,  DAT00310 

f25H  IS  OUT  OF  RANGE  OF  MODEL!  DAT00320 

102  F0RMAT<21X,37HGUNFLASH  HAS  HOT  OCCURED  YETi  TIME  =  , 1 X, F8 . 3, /, 42X, DAT00330 

■*16HT1ME  OF  FLASH  »  ,1X,F8.3!  DAT00340 

103  F0RMAT<21X,38HFLASH  IS  NOT  IN  DETECTOR  FIELD  OF  VIEW!  DAT00350 

104  F0RMAT<21X,24HFLASH  IS  BEHIND  TARGET — ,  DAT00360 

*15H  NO  OBSCURATION!  DAT00370 

105  F0RMAT<21X,24HH0RMAL  PROGRAM  EXECUTION!  DAT00380 

URITE< I00UT,99>IST0P, ISEE, ILOC  DAT00390 

IF< ISTOP.GT. 1 !GO  TO  1  DAT00400 

IF< ISTOP.GT. 0!GO  TO  10  DAT00410 

WRITE< lOOUT, 1 00!ISRC  DAT00420 

GO  TO  9999  DAT00430 

10  WRITE<  lOOUT,  1  01  !UIAVE  DAT00440 

GO  TO  9999  DAT00450 

1  WRITE< I00UT,97>I1< 1ANS1  !, I2< IAN31 !, I1< IANS2!, I2< IANS2!  DAT00460 

IF< ISEE.LT,2.AND. IL0C.LT.2!C0  TO  11  DAT00470 

IF< ISEE.EQ.2!WRITE< lOOUT, 82!  DATi "480 

IF<  ISEE.EQ.SiWRITEi:  I00UT,83!  DAT00i90 

IF< IL0C.EQ.2!WRITE< I00UT,92!  DAT00500 

IF< IL0C.EQ.3!URITE< I00UT,93!  DAT0051 0 

GO  TO  9998  DAT00520 

11  IGO=ISTOP-l  DAT00530 

GO  TO  <2, 3, 4, 5, 6,7, 8, 9!, ICO  DAT00540 

2  URITE< lOOUT, 1 02  !TIME,T1MGUN  OAT00550 

GO  TO  9999  DAT00560 

3  WRITE< lOOUT, 1 03!  DAT00570 

GO  TO  9999  DAT00580 

4  WR1TE< lOOUT, 1 03!  DAT00590 

GO  TO  9999  DAT00600 

5  WR1TE< lOOUT, 1 04!  DAT00610 

GO  TO  9999  DAT  0  062  0 

6  URITE< lOOUT, i 03!  OAT0063G 

GO  TO  9999  DAT 00640 

7  WRITE<IOOUT,103)  DATu0650 

GO  TO  9999  DAT00660 

8  WRITE<IOOUT,103>  DAT00670 

GO  TO  9999  DAT00680 

9  WRITE< lOOUT, 1 05!  DAT00690 

9998  WP.1TE<  lOOUT, 98!T1MLEF,T1MH0L  DAT00700 
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9999  RETURN 
END 


DrtT0u7i 0 
DAT  00720 
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SUBROUTINE  GET  Ii>H  FLrtSHR ,  FLhSHT,  ISTOP,  ISEE,  ILOC,  TIMLEF,  TIMNOL  ) 

*  SUBROUTINE  GETIM 

*  flhsh  module 

*  EuShELBO 

41%  4(4<  4<4t  4i4(4(  >l(  lit  «l<  4(4(41  4t4i4(4t%  111  4(4(414(3^ 

REAL  LOOSTO  LOCPRA 
COMMON/ 1 DATA/ROBS<  3  >. RTAR<  3  > , TARDEG , RSRC<  3 ), T IMGUH , FOV , WAVE . 

♦  RADSEE , RAOLOC . TARLEH , TARU ID , TARHGT , PCTSEE , PCTLOC , 

*  TIME, ISRC,RCTSEE,RCTLOC 
COMMOH,''COHST/P1 

C.***^=«.hLL  distances  in  meters  angles  CONVERTED  TO  RADIANS<CCW  A-AXES 
DIMENSION  DOTVEC<  3  ) , RHTVEC<  3 ) , RHFVECC  3  > , RFLASN<  3  > 

C*****SCAL,AR<  A,  B  >  =  A<  1  )*B<  1  )+A<  2  )*e<  2  >+A<  3  )*B<  3  > 

SCALAR<  A1  ,A2,A3,B1  ,  B2 ,  B3  >= A1  >«<B  1 +A2*B2+ A3+B3 

c+***h.defaijlt  and  convert  input 
ANGGUH  =  Ci .  0 
ELEGUN=0 , 0 
GUHhT=0 . 0 
GiJNLEN=0  ,  0 
I ARHHT= I ARHOT/^ . 0 
ANGTAR=TARDEG>*<PI/1S0,  Oi 
HA»-FOV=<  FOv/2 . 0  >*(  F  1/ 1 80 . 0  ■; 

SEESTO=RADSEE/1 000.0 
LOCSTO=RADLOC/1 000 . 0 
SEEFRA=PCTSEE/t  00. 0 
LOCFRA=PCTLOC/1 00. 0 
RADFL=FLASHR 
DURTIM=FLASHT 
DURSEE=1 0. OfRCTSEE 
DURLOC=1 0. O^RCTLOC 
REACFA=SEEFRA-LOCFRA 
C**>**>»cIhITIALIZE  FLAGS  >!<♦*’*■» 

AGrNSE=0. 0 
AG1NLO=0. 0 
T1MLEF=0. 0 
TIMNOL=0. 0 
TIMG0N=T1ME-TIMCUN 
ISEE-0 


ILOC=0 

ISTOP=0 

IF< ISRC. 

ISTOP=l 

IWAVE=0 

IF<UiAVE 

IF<WAVE 


LT. 1 .OR. ISRC.GT.2)G0  TO  9S9S 


GE. 

GE 


,40, 

00 


AND. WAVE. LE. 
AND. WAVE. LE. 
TO  9999 


0.70>IWAVE=1 
12.0  )IWAVE=2 


IF< IWAVE.EQ. 0)G0 
IST0P=2 
IF<TIMGON.LT. 0.  )GO  TO  9999 
TIMLEF=0URTIM-T1MG0N 
C**^**TIMLEF  IS  DURATION  LEFT  OF  FLASH 
TIMNOL  »TrMLEF+REACFA*DURTIM 
C+***^TIMNOL  IS  DURATION  OF  LOCK 
FLSHIF=RADFL 

C***#*CALCULATE  FLASH  COORDINATES  FROM  GIVEN  COORDINATES 
RFLASH<  1  >«>RSRC<1  )+FLSHIF*COS<  ANGGUN  >*COS<  ELEGUN  > 
RFLASH<  2  >-RSRC<  2  >+FLSHIF<iSIN<  ANGGUN  >'*COS<ELEGUN  > 
RFLASH<3)=RSRC<3)+FLSH1F*SIN<ELEGUN)  *  GUNHT 
C*****DEFINE  DIRECTION  OF  TARGET  UNIT  VECTOR 
DOTVEC<  f )-COS<ANGTAR) 

DOTVEC<  2  )=SIN<  ANGTAR  > 

DOTVEC<3>-0. 

C#*m.**DEFINE  OBSERVER-TARGET, OBSERVER-FLASH  VECTORS 
DO  to  1=1,3 

RHTVEC< I >-RTAR< I )-ROBS< I  ) 

RHFVEC< 1  )=RFLASH< 1 )-ROBS< I  ) 

10  CONTINUE 

C****»AOD  HALF  TARGET  HEIGHT 

RHTVEC<  3  >»RHTVEC<  3 )+TARHHT 
C**»**FIND  LENGTHS 


GTMCiOOi  0 
**.k*GTM0C020 
•GTMOOOj  'i 
■••GTM0004U 
=GTM0  0050 
♦  ♦♦itiGTMOOObO 
GTM00070 
GTM00080 
GTM00090 
GTM001 00 
GTM001 1 0 
GTM001 20 
GTM001 30 
GTMOOMO 
GTM00150 
GTM00160 
GTM001 70 
GTM001 SO 
GTMOOtvO 
GTM00200 
GTM0021 0 
GTM 00220 
CTn00230 
GTM00240 
GTM 00250 
CTM00260 
GTM 00270 
GTM00280 
GTM00290 
GTM00300 
GTMU031 0 
GTM00320 
GTM 00330 
GTM00340 
GTM00350 
GTM00360 
GTM00370 
GTM00380 
GTM0u390 
GTM00400 
GTM0041 0 
GTM00420 
GTM00430 
GTM00440 
GTM 004 50 
GTM004S0 
GTM00470 
GTMO: ’AO 
GTM004y 0 
GTM00500 
GTM0051 0 
GTM 00520 
GTM00530 
GTM00540 
GTM00550 
GTM00560 
GTM00570 
GTM00580 
GTM00590 
GTM00600 
GTM0061 0 
GTM00620 
GTM00630 
GTn00640 
GTM00650 
GTM00660 
GTM00670 
GTM00680 
GTM00690 
GTM00700 
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h1»kHTvEC< 1  > 

i 

1 

1 

i 

i 

GTrOOZiu 

A2=RHTVEC<2> 

GTM 00720  1 

h3=RHTVEC<3 j 

GTri00730 

B1=RHFVEC<  1  > 

GTM00740 

B2=RHFVEC<2> 

GTM00750 

B3=RHFVEC<  3> 

GTM00760 

RHT=SQRT<  SChLhR<  A1  ,A2,A3,Hl  ,A2,A3;)) 

GTM00770 

RHF»SQRT<SCALAR<B1 ,B2,B3<B1  .B2,B3>) 

GTM007e0 

C*****FIND  COSINES  BETWEEN  VECTORS 

GTM00790 

Cl=DOTVEC< 1 > 

GTM00800 

C2=D0TVEC<  2 i 

GTMOOSl 0 

C3-DOTVEC<3> 

GTM 00820 

GAMMAD-  SCALAR<C1  .C2,C3.Bi  ,B2.B3>/'RHF 

GTM00830  ’ 

GAMMAT=  SCALAR<A1 ,ft2,A3,B1 , 82 , B3 >^< RHT*RHF > 

GTM00840 

U  =  SCALAR<C1 ,C2,C3,A1 ,A2,A3>/RHT 

GTM00850 

C****i.FIHD  TRIG  FCNS  OF  THeTA  =  HrtLF-ANGLE  OF  FLASH  CONE 

GTMooeeo 

SINTH=RAC>FL.>'RHF 

GTMOOa.'O 

COSTH=StilRT<  1  .  0-SINTHi>SINTH) 

GTM00880 

C0S5Q=C0STH<4>C0STH 

GTM00890 

COSINEsAB&<U> 

GTM00900 

' 

SINE=S£IRT<  1  .  0-COS1NE'*>«2  > 

GTMOOSl 0 

C***>t.*CALCLiLATE  CYLINDRICAL  TARGET  LONGEST  DIMENSION  AS  SEEN  IN 

GTM 00920 

! 

C!X*Ktmi«tpLANE  PERRENDICULAR  TO  RHFVEC 

GTM00930 

TARD1M-TARLEN--*SINE+TARWID-*C0SINE 

GTM00940 

HAFDIM=TARDIN/’2. 

GTM00950  ! 

i 

THETA=ATAN2<  SQRT<  1  .  0-COSTH#>*2  COSTH  > 

GTM00960 

THETAT=ATAN2<  SQRT< 1  . 0-GAMMAT**2 ), GAMMAT  > 

CTM00970 

DELTH=THETAT-THETA 

GTM00980 

IST0P=3 

GTM00990 

IF<DELTH.GT.HAFFOV>GO  TO  9999 

GTM01000  1 

C*****IF  OUT  OF  FIELD  OF  VIEW, RETURN. 

GTM01010 

DISPLC*RHT*SIN<  DELTA  ) 

GTM01020 

PROJRH-RHTfGAMMAT 

GTM01030 

IST0P=4 

GTM01040 

IFCOISPLC.GT.HAFOIM-iCO  TO  99 

GTMOIOSO 

IST0P«=5 

GTM01060 

I F< PR0JRH.lt. RHF.ANO.IUAVE.lt. 2 )GO  TO  99 

GTM01070  i 

C.t<*«**NO  OBSCURATION  IF  TARGET  IN  FRONT  OF  FLASH  SO  RETURN 

GTM010S0  ! 

C^.^**»FROM  HERE  OH,  GAHMAT  NECESSARILY  POSITIVE 

GTM01090  1 

C***.».*FIND  INTERSECTIONS  OF  FLASH  COHE  WITH  DOTVEC  EXTENDED  FROM  TARGET 

GTM01100 

I 

C*****GET  COEFFICIENT  OF  GUADRATIC  EQUATION  FOR  DISTANCE  ALONG  DOTVEC 

GTMOl 110  ' 

C*****FROM  TARGET  TO  FLASH  CONE/'RHT 

CTM0M20  1 

A  =COSSQ  -GAMMAD-*-*>2 

GTM01130 

BD2=C0SSQ*W-GAMMAD-*GAMMAT 

GTM01140 

C  =CuSSQ  -GAMMAT>*‘>*‘2 

GTMOl 150 

B3BD2*2 . 

GTM01160 

C*****IF  DISCRIMINANT  NEGATIVE,  NO  INTERSECTION 

GTMOl 170 

DISCRM=BD2*BD2-A*C 

GTMOnSO 

IST0P-=6 

GTM01190  I 

IF<D1SCRM.LT. 0. )G0  TO  99 

GTM01200 

C***#*IF  A=0, QUADRATIC  FORMULA  BLOWS  UP. ACTUALLY  HAVE  LINEAR  EQN. 

GTM01210 

IF<  ABS<  A ) . CT . 1  . E-30  >GOT020 

GTM01220 

iF<ABS<B).LT. 1 . E-30 )B-SIGN< 1 .E-30,B> 

GTM01230 

SPL=-C/B*RHT 

GTM01240 

ZPL=SPL*GAMMAD+PROJRH 

GTM01250 

IST0P=7 

GTM01260 

IF<ZPL.LE. 0.  )  GO  TO  99 

GTM01270 

C*=i.*»h.REJECT  if  SOLE  INTERSEC  IS  U  NEC  COHE  SHEET .  MEANINGLESS 

GTM01280 

DPL=ABS<SPL >*SINE 

GTM01290  1 

IF<GAMMAT-C03TH>14, 14, 12 

GTM01300 

C*».*h.^IF  tar  OUTSIDE  FLASH  CONE  GO  TO  14, OTHERWISE  12 

GTM01310 

12  OBSCUR=HAFDIM+AMIN1<DPL,HAFDIM) 

GTM01320 

GO  TO  30 

GTM01330 

14  OBSCUR-AMAXU 0. ,HAFDIM-DPL) 

GTM01340 

' 

GO  TO  30 

GTM01350 

1 

20  R00T-SQRT<DI8CRM> 

GTM01360 

ROOT=SlGN<ROOT,A) 

GTM01370 

C*«***ABOVE  NOT  REALLY  NEEDED  BUT  NICER  TO  HAVE  SPL . GT . SM I -SEE  BELOW 

CTM01380 

SPL-<-8D2+R00T>/A  •RHT 

GTM01390 

SM1=<-BD2-R00T>/'A  nRHT 

GTM01400 

t 

j 

■] 
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Cx.+***SPL,SMI  ARE  2  LENGTHS  ALONG  OOTVEC  OF  IHTERSEC  PTS  U  FLASH  CONE 
Ch.**^*ZPL,ZMI  ARE  Z  COORDINATES  OF  INTERSECT10NS< ON  FLASH  CONE  AXIS> 
ZFL=SPL*GAMNAD+PROJRH 
2M I  =SM  I  ■cGAMMAD+PRO  JRH 

IRZPL.LE.  0,  .ANO.ZMI  .LE,  0,  )GO  TO  99 
=*****rEjECT  if  both  INTERCEPTS  IN  NEGATIVE  CONE 
*♦***[, PL,  DMI  ARE  PROJECNS  OF  SPL,SMI  PERPEN  TO  RHTVEC 
♦♦***THE1R  MAGNITUDES  APE  LIMITED  TO  HAFDIM 
OPL=SPLkSINE 
DPL=AMIN1 < DPL, HAFDIM  ; 

DPL=AMAX 1 <  DPL , -HAFD I M  ) 

DMI=SMI>*.SINE 

DM I*AM IN  1 < DMI , HAFDIM) 

DMI=AMAXU  DM1 ,  -HAFDIM  > 

OBSCUR=ABS<DPL-DMI  ) 

IF<2PL*2MI .GT. 0.  )GOTO30 

C*****SKIP  AROUND  UNLESS  BOTH  SHEETS  OF  CONE  INVOLVED 
IF<ZPL.LE. 0.  )DPL=SIGN< HAFDIM, DPL) 

IFCZMI .LE, 0,  )DMI=SIGN< HAFDIM, DM  I > 

0BSCUR=TARD1M-ABS< DPL-DMI  ) 

C****^A60VE  BRANCH  RARE . I NTERS6C  U  BOTH  COHE  SHEETS, NEC  SHEET  IGNORE. 
30  CONTINUE 

SEEN-TARDIM-OBSCUR 

IST0P=9 

98  IF< IUAVE.EQ.2)G0  TO  1 

CALL  VSBLC< ISEE, ILOC , SEEN, TARDIM, RHT, TIMLEF, SEESTO, LOCSTO, 

*  SEEFRA,LOCFRA) 

GO  TO  99 

1  CALL  IRBLCCRHF, ISEE, ILOC , AGINSE, AGINLO, OURSEE, DURLOC, TIMGON  ) 

99  CONTINUE 

TIMLEF  «AMAX1<TIMLEF, AGINSE) 

T I MNOL=AMAX t  <  T IMNOL , AGINLO  > 

9999  RETURN 
END 


GTM0141 0 
GTM0t420 
CTM0143  ) 
GTM01440 
GTMOi 450 
GTM0t460 
GTM01 470 
GTM014SO 
GTM01490 
GTMOfSOO 
GTMOi 51 0 
GTM01520 
GTM01530 
GTM01540 
GTM01550 
GTMOI 560 
GTMOI 570 
GTM0158CI 
GTMOI 590 
GTMOI 600 
GTM0161 0 
GTMOI 620 
GTM01630 
GTMOi 640 
GTMOI 650 
GTM01660 
GTMOI 670 
GTM01680 
GTM01690 
GTM0t700 
GTM0171 0 
GTM01720 
GTM01730 
GTM01740 
GTM01750 


SUBROUTINE  IRBLCcRHE, ISEE, ILOC,hGINSE,hGINLO,E»URSEE^DURLOC^  TIMGOH  jIRBuCOI u 

♦  ***i.*IRBLC020 

C*  SUBROUTINE  IRBLC  »IRBLC030 

C*  FLASH  MODULE  *IRBLC040 

C*  EOSAEL80  ■•■IRBLC050 

(Q  4i  %  4t  %  %  iliitt  Ht  4t  4i  4i  >lt  Ht  ♦  4*  %  %  4i  %  111  Hi  4t  4i  4i  ♦  4(  Hi  4i  4i «  %  ♦  4i  4i  4i  4i  4^  4c  4t  4t  ♦  ♦  %  4-- %  alt  ♦  ♦  94(i*t «  %  4t  4i «  %  «  4c  Hi  %  %  11^  B  L  C  0  6  0 

INTEGER  LOCIRM  iRBLC070 

SEEIRM»4.0  1RBLC080 

LOCIRMaS.U  IRBLC090 

3GRTRH«S£(RT<RHF)  IRBLC  100 

hGIN5E=0URSEE/'SukTkH  IRBLCifO 

AGlNL0»DURL0C7SaRTRH  lRBLCi20 

C****»«BOVE  WHOlLV  EMPIRICAL  FROM  FIT  TO  TV  TAPES  AT  2  RANGES  IRBLCi30 

IFiAGINSE.GT.SEEIRM)  AGINSE=SEEIRM  IRBLCt40 

IF< AGINLO , GT . LOC IRM >  AGINL0=L0C1RM  IRBLCiSO 

IF<AGINSE.GT.T1MG0N)  ISEE-1  IRBLCISO 

it-<  AGINLu  .  GT  .  TIMGON  )  IL0C=1  IRBLCliO 

RtTURN  IRBLCISO 

tNb  IRBLCiSO 


t 
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SUBROUTINE  V3BLC< ISEE, ILOC , SEEN, TARDIM, RHT, TIMLEF, 3EEST0 , LOCSTO ,  VSBLCCH  0 
«  SEEFRft,LOCFRA>  VSBLC020 

*  SUBROUTINE  VSBLC  =*  VSBLC 04  0 

■*  FLhSH  module  *  VSBLCuSO 

*  EOSNEL80  •*  VSBLC060 

REAL  LOCCRI .LOCFRA.LOCSTO  VSBLCOSO 

C»<i**.(.3EEFRA  IS  FRACTION  THAT  MUST  BE  SEEN , L IKEWISE  FOR  LOCK  VSBLCOSO 

C****.*SEESTO  IS  MIN  ANGLE  THAT  MUST  BE  SEEN.  L IKEWISE  FOR  LOCK  VSBLCtOO 

SEEANG=SEEN/'RHT  VSBLC  1)0 

TARANG=TARDIM/'RHT  VSBLC  120 

jj  +  *>**=*DEFINE  SEEN  ANGLE  AND  TARGET  ANGLE  VSBLCiSO 

SEECRI=AMIN1 <  TARANG . SEESTO  ;  VSBLC 140 

LOCCRI=AMIN1<  TARANG.LOCSTO)  VSBLC 150 

IFCTIMLEF.LE.  0.  :iGO  TO  9S9S  VSBLC  160 

IF'.  SEEANG  .  LT  .  SEEFRA»TARAHG  >GO  TO  4S  VSBLC170 

ISeE=2  VSBLC1S0 

GO  TO  50  VSBLCiSO 

4h  IFCSEEANG.LT.SEECRI >G0  TO  49  VSBLC200 

I3EE=1  VSBLC2iO 

GO  TO  50  VSBLC220 

49  CONTINUt  vSbLC2.iO 

ISEE=3  VSBLC.240 

50  CONTINUE  VSBLC250 

IF<,SEEANG.LT.LOCFRA*TARANG)CO  TO  98  VSBLC260 

IL0C=2  V3BLC270 

GO  TO  9999  VSBLC280 

98  IFCSEEANG.LT.LOCCRI  :)GO  TO  99  VSBLC290 

ILOC=1  V3BLC300 

GO  TO  9999  VSBL.C310 

99  CONTINUE  VSBLC320 

IL0C*3  V3BLC330 

9999  RETURN  VSBLC340 

END  VSBLC350 
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ECiRUN 

,  4 . 0 

UAVL 

,  10.6 

10.6 

VIS 

,  7 . 0 

TURB 

XSCALE 

3.0 

SMOKE 

ORTRAn 

LZTRrtN 

CL  1 Rhn 

,  3.0 

SCREEN 

uvRCS 1 

,  2 . 0 

CLIM9T 

,  1  .  0 

1.0  5.0 

6,0  -> 

1.0  1.0 

GRNi^OE 

uU 

PhRM 

0.101b  1 .3E-04 

0 . 0 

4  00. 0 

5 . 0 

CN1 

1  . 

0  6.0E-13 

1 . OE-14 

1  .3E-14 

2.7E-14 

VI 

1  . 

0  0.93 

0 , 93 

0 . 93 

0 , 93 

DVRV 

0.400 

500 . 0 

CN2 

1  . 

0  6. Uh-13 

1  , OE-14 

1  .  3E-i  4 

2 . 7E-1  4 

V2 

1  . 

0  0.93 

0,93 

0.93 

0 . 93 

GO 

ENC’ 

FOG 

1  . 

HORZ 

0 . 4 

GO 

FOG 

2  , 

SLnH 

0.133,56 

.3 

GO 

FOG 

3. 

HORZ 

0.4 

GO 

END 

MUNC 

0.0 

-50 .  u 

0 . 

OBSC 

200. 

0. 

2.0 

ThRC 

-200. 

0 . 

2 .  u 

BART 

5, 

180, 

5. 

90 . 

uUTR 

0 . 

0. 

0 . 

0. 

BURN 

10, 

0. 

0, 

0. 

0. 

GO 

BURN 

4. 

0. 

0. 

0. 

0  . 

BART 

5. 

250. 

5. 

90. 

GO 

DONE 

END 

METl 

4. 

2.  286.0  2. 

2.0 

0. 0 

METZ 

1  . 

53, 

SOIL 

2. 

0.0  0. 

15 

CHAR 

3. 

6.8  0 

.  0 

EXPL 

1  . 

1  . 

1  .  0.0 

0.0 

0 . 0 

OBSC 

200.0 

0.0  2 

.  0 

TRNC 

-200.0 

0.0  2 

.  0 

RECC 

200.0 

0.0  2 

.  0 

TIMS 

1  .  0 

71.0  2 

.  0 

GO 

1  . 

DONE 

END 

8.55 

15. 

0.4 

END 

SEEK, 

0,2, 

0.0, 

0 . 6 

TARG, 

-0,2, 

0.0, 

0.002 

CLST, 

0.20, 

0.40 

GO 

SEEK, 

0.133, 

0.0, 

0,5 

GO 

SEEK, 

0.0, 

0.0, 

0.3 

GO 

END 

1  1  t 

TARV 

1  . 

0  2.0 

0.24 

2.3 

81  . 

SENS 

.99  8. 

1  . 

0. 

0  . 

512.0 
5 , OE-14 
0 . 93 

5. OE-14 
0.93 


0.0  0.0 


2. 
1  . 


0.0 


.  000 
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GO 

SENS 

.90 

8 

GO 

SENS 

,  75 

8 

GO 

SENS 

.50 

8 

GO 

SENS 

.  t  0 

8 

GO 

DONE 

1 . 

0  . 

0  . 

1 

1 . 

0. 

0  . 

1 

i . 

0 . 

0  , 

1 

1 . 

0 . 

U  . 

1 

SCkn 

DONE 

15. 

400  , 

0 . 4 

0. 

90.  74. 

END 

OPOS, 

-0 . 0667, 

0.0, 

0.2 

CLDS, 

0.2, 

200.0. 

4  0.0, 

0.7, 

1  .  0 

SPOS, 

-0,2, 

0.0, 

0.  002 

BK  GR , 

50. 0 

GPND, 

50. 0 

TEMP, 

GO 

9.S 

UPUb  , 

-0.1 553, 

0.0, 

0  ,  1 

GO 

END 

NfJflb 

CiUTP 

OB  SC 

200.0 

0.0 

2.0 

MiJNC 

-200.0 

0 .  0 

2 . 0 

93 . 0 

i 00 . 0  10.0 

TARC 

-200.0 

+4  0 . 

2 . 0 

BART 

5.0 

400. 0 

5.0 

14.3 

90 . 0 

MUNT 

I  .  0 

0.793 

1  .  0 

0.0  4.7 

ME  TR 
EXTC 
BURN 
MISC 

GO 

DONE 

50.0 

2. 0 

220.0 

4 . 0 

20.0  0.0 

END 

WAVL 

,  1  .  06 

1  .  06 

VIS 

BASCAT 

,  5.0 

5. 0 

4 . 0 

FCLOUD 

GO 

PART, 

1  .  , 

5000.  , 

1  . 

SORC, 

-0,2, 

0.  , 

-0 . 098, 

90.  , 

0  .  ,  50 , 

DETR  . 

0,2, 

0.  , 

-0.098, 

90.  , 

180,  ,  1  ,  , 

CLDS, 

.  1  , 

.2, 

.  1  , 

0.  , 

0  ,  ,  0  ,  , 

GRHD, 

-0,1, 

0.5 

PULS, 

GO 

.33, 

0. 

END 

CP03 , 

0.0, 

0.0, 

0.  1 

RPOS, 

0,2, 

0.0, 

0 . 002 

SP03, 

-0,2, 

0 . 0, 

0 . 002 

AXES, 

0.1, 

0.2, 

0  .  1 

CLDS, 

5.0, 

0.95, 

4.0, 

1  .  0, 

9.8 

ATMO, 

2.0, 

9.8 

BKGR, 

0,5, 

50.0 

SANG, 

80. 0, 

0.0 

LUND, 

GO 

0.0 

END 

FREQ 

,  35.0 

35.0 

HMMU 

,  2.0 

GO 

PATH, 

0,4 

ATMO, 

15.0 

1013.25 

6.44 

FOGD, 

0,5 

RAIN, 

GO 

5.0 

ATMO, 

-1  .  0 

1015.2 

7.7 

z . 


0.  0 

u .  0 


1 

5 
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RhIN, 

0.0 

SNOW, 

GO 

5.0 

END 

UVNUM 

LT4M 

RESF 

SPOT 

GO 

2010.  2710 

2 . 

EHVR 

3. 

2  . 

2. 

EMIS 

. 1 00+01 

. 283+03 

.950+00 

hTM 

. 650+02 

0 . 0 

.  0 

ThRG 

. 400+00 

.  450+02 

.900+02 

REEL 

0,5 

0.5 

.  0 

SENS 

GO 

.200-02 

. 900+02 

.270+03 

i  2 

3.S, 

0,78 

3.6, 

0.83 

3.7, 

0.87 

3.3, 

0.92 

3.9, 

0.96 

4,0, 

0.98 

4,1, 

0 . 97 

4.3, 

0.96 

4.5, 

0.95 

4.7, 

0.94 

4.9, 

0.93 

5.0, 

0.93 

END 

4  2 

1 

0  10  0 

0  0 

0.000 

0 

.  002 

0.002 

0.000 

0 .4  00 

4 

4  2 

1 

0  10  0 

0  1 

0. 000 

u 

END 


4, 

. 295+  03 

.450+02 
.500-01 
. i OO+Oi 


0.000 

0.000 

0,000 
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INTEGRATED  COHERENCE  LENGTH  .934983  <  METERS.) 
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.  000 

.  002 

.245 

4.89 

.000 

.  000 

.  001 

181 

3.48 

.  000 

.  001 

.  005 

.296 

2.58 

.  000 

.  004 

.  019 

.4  05 

1 .98 

.000 

.  013 

.  047 

•  498 

1 .58 

.  001 

.  033 

.  088 

.575 

1  .29 

.004 

.  062 

.138 

■  638 

1  .  07 

.  01  0 

.  099 

.193 

■  688 

.90 

.021 

.  142 

.250 

.  730 

.77 

.  036 

.189 

,  305 

•  764 

.67 

.  057 

.236 

.358 

.  792 

.58 

.  081 

.283 

.407 

.815 

.52 

.  109 

.328 

.452 

.835 

.46 

.139 

.370 

.493 

■  352 

.41 

.  171 

.411 

.531 

■  666 

.37 

.203 

.448 

.565 

■  878 

.34 

.235 

.483 

.596 

■  889 

.31 

.267 

.515 

.624 

■  898 

.29 

.299 

.545 

.649 

.906 

.26 

.330 

.572 

.672 

.914 

.24 

.359 

.597 

.693 

•  920 

.22 

.387 

.620 

.712 

.926 

.20 

.414 

.642 

.729 

.931 

.19 

.440 

.662 

.  745 

.935 

.18 

.465 

.680 

.  760 

.940 

.17 

.488 

.697 

773 

■  943 

.  16 

.510 

.712 

.786 

.947 

.15 

.  531 

.727 

.797 

.950 

.14 

.550 

.740 

.808 

.953 

.13 

.569 

.753 

.817 

.955 

.12 

.587 

.765 

•  826 

.958 

.12 

•  603 

.776 

.835 

.960 

.  1 

.619 

.786 

.842 

.962 

.821 

.809 

.840 

.829 

.999 

.856 

.  846 

1  .000 

.870 

.861 

1  000 

.882 

.dr4 

1  .  000 

.893 

.885 

1  .  000 

.902 

.894 

1  .  000 

.91  0 

.903 

1  .  0  0  M 

.917 

.91  Cl 

1  .000 

.923 

.917 

1  .  000 

.9i6 

.923 

1.000 

.933 

.928 

.938 

.933 

.942 

.  937 

.945 

.941 

1  .  u  I)  0 

.948 

,945 

1  .000 

.951 

.94? 

.954 

.951 

1  000 

.957 

.953 

t  ,  000 

.959 

.956 

1  .  000 

.961 

.  938 

1  .  000 

.963 

.  960 

1  .  000 

43b 


1 


*  SMOKE  ♦ 

*  « 


SnO^E  MUNITIONS 
hC  'jMOKE 
NO  P.OUNC-S  I 
fill  i*'EiLiHT  iP 

euftM  time  100 

EFFICIEmCV  40 
VIELO  FhC TOP 


METEOftOLOOTCAL  CONDITIONS 

r-ict-ccr^  -  V 


£ . 


190  LB 
0  SEC 

PEPCEH'^ 


UINDSPEED 
UIND  DIRECTION  < USUAL 
MET  convention  A2IMUTri'! 
RELATIVE  HUMIDITV 
PASwUILL  CNTEOORV 
AIR  temperature 
TEMP.  GRADIENT 


225 . 
87. 


6  M/S 

DEGREES 

PERCENT 

DECREE  C 
C  DEG./M 


E  K  t  C  U  T  I  0  N 


E/TINCTION  CijEFFiClfcti 
0.4-0."  MIlkl'METEkS  ■ 
0.7-1  I  MICRuNETER- 
1  . OS  Mi CftOriETEKS 
3. 0-5, 0  MICROMETERS 
B.0-I2.  micrometers 
1 O.G  MICROMETERS 
•=*4 . 0  GHZ 


BURN  RATE  PROFILE 


.5370+  .4760  <T/TBURN>  ♦  4.7790  <  T/TBURN  ^■♦♦2  ♦  -5.4720  (T/TBURNjw^S 


04  L' 
190 


.  051 
.  001 


M-* 

m** 


•  u;’ 

C." 


M  »  ♦  i'.  u''* 
T) *  ♦  j ,  Cm 


CM 

CM 


FIELD  COORDINATES 
<  »<  ■>  f  Y  ) 

MUNITION  coordinates*  .00  -50.00 

OBSERVER  COORDINATES®  200.00  .00 

target  coordinates®  -200.00  .00 

HMCLE  OF  ORIIINAL  X-flXIS,  CLOCKWISE  URT  NORTH  - 
EVENT  TIME  =  . 0  SEC 


<Z> 

.  00  meters 

2.00  METERS 
2.00  METERS 
90,00  DEC- 


ROTATED  COORD. <UIND  X-AXIS,  MUNITION  C-CIGIH: 
<'XW>  <VUn  (ZUi") 

.,.00  .00  ,00  METERS 

"106,07  2.00  METERS 

-106. u7  176.78  2,00  METtFS 


TIME 

LENGTH 

WIDTH 

HEIGHT 

PATHLEHi 

•:  SEC  > 

< METERS > 

<MeTEPS> 

<METEftS) 

<  MET£R< 

5. 

18. 

13. 

.  00 

1  0  , 

36  . 

16  . 

8. 

.  00 

15. 

54. 

20. 

10. 

.  00 

2  0. 

72. 

23. 

1  1  . 

15.56 

25  . 

90 . 

27, 

12. 

30. 12 

3  0 . 

108. 

31  . 

13. 

28.24 

35  . 

126. 

34. 

14. 

26.88 

40 . 

1  44  . 

38, 

16. 

25.86 

45 . 

162. 

41  . 

17. 

25.  07 

50 . 

180. 

45. 

18. 

24 . 42 

55  . 

198. 

49. 

19. 

23.89 

6  . 

216  . 

52  , 

20. 

23 , 45 

65 . 

234  . 

56. 

21  . 

23. 07 

70. 

252. 

59, 

23. 

22.75 

r'  S'  . 

270, 

63 

24. 

22.46 

•?  O  . 

288. 

67  . 

25. 

22.22 

6  3  , 

306 . 

70, 

26. 

21  .99 

yO  . 

324  - 

74  . 

21  .80 

95  . 

342  . 

77. 

29. 

21  .62 

f  0  0  , 

360 . 

81  , 

21  .46 

1  05  . 

378. 

85  . 

31  . 

21  . 32 

110, 

396. 

88  . 

32. 

21.18 

1  15, 

414  . 

92. 

33. 

21  .  06 

120. 

432. 

95. 

35  . 

20.95 

1  25 . 

450. 

99, 

36  . 

20.85 

130. 

468. 

f  03. 

37. 

20.75 

1  35 

486  . 

1  06. 

38  . 

20.67 

140, 

5  04  . 

110. 

39. 

2  0.56 

145. 

5j2  . 

113, 

40. 

20,51 

150, 

540. 

117, 

42. 

2  0.44 

1  55 

558  . 

121  . 

43. 

20 . 37 

}  60 

576 

124  , 

44  . 

20.30 

1  65  . 

594. 

128 

45. 

20,25 

17  0 

612  . 

131  . 

46. 

20. 19 

1  7"  . 

630 . 

135. 

48. 

20. 14 

t  F.  0  . 

646. 

1  39  . 

49  . 

20.09 

185. 

666  . 

142  , 

50. 

20. 04 

19  0. 

684  . 

146. 

51  . 

19.99 

1  95 

702 . 

1  49  . 

52. 

19.95 

2  0  0 . 

72  0 . 

i5i. 

54. 

19.91 

4.’  05  . 

.'38 . 

15  7. 

55  . 

19.87 

»  1  u  . 

756 

160  . 

56  . 

!«■  83 

CL 

<GM/M**2> 


transmission 


0.4-0. 7  07- 


215  , 
22  0. 
225  . 
230  . 
235 
24  0 


74  . 
792  . 
810. 
828  , 
846 . 
.964  . 
882  . 
9  ij  0  , 


164  . 
167. 
171  . 
1  75  . 
1  78. 
182. 
185 
189. 


57  , 

58  . 

59  , 
61  . 
62. 
63. 

64  . 

65 


»  .80 
1  •  77 
1  9;73 
19,70 
19.67 
19.64 
19.62 
19.59 


.  00 
.00 
.01 
f  .  16 
2.00 
2.31 
2 . 63 
2.98 
3.35 
3.73 
4.11 
4.47 
4.80 
5.09 
5.30 
5.44 
5.49 
5.42 
5.22 
4.87 
4.37 
3.68 
2.79 
t  .28 
.62 
.47 
.37 
.30 
.25 
.21 
.  18 
.15 
.13 
.  1 1 
.  1  0 
.  09 
.  08 
.  07 
.  06 
.  06 
.  05 
.05 
.  04 
.  04 
.  04 
.  03 
.  03 
.  03 
.  03 
.  02 


1 .000 
1  .  000 
.949 
.  COS 
.  000 
.000 
.000 
.  000 
.  000 
.000 
.000 
.000 
.  000 
.000 
.  000 
.  000 
.  000 
.  000 
.  0  00 
.  000 
.  000 
.  000 
.000 
.  003 
.  058 
.  116 
.  182 
.251 
.319 
.384 
.443 
.498 
.547 
.591 
.  630 
.  6''5 
.696 
.723 
.748 
,770 
.789 
.806 
.  822 
.  836 
.849 
.860 
.871 
.880 
.888 
.896 


1  .000 
f  .  DOC 
.975 
.  079 
.  013 
.  006 
.  003 
.  001 
.  OOl 
.  000 
.000 
.  000 
.  000 
.  000 
.  000 
.  000 
.000 
.  000 
.  000 
.  000 
.  000 
.  000 
.  002 
.  060 
.257 
.358 
.443 
.517 
.579 
.633 
.678 
.717 
.750 
.778 
.802 
.823 
.84  1 
.857 
.870 
.882 
.893 
.902 
.911 
.918 
.  925 
.951 
.936 
941 
.945 
.949 


1  .  UOO 
I  .000 
,977 
.  094 
.  017 
.  0  09 
.  005 
.  0  02 
,001 
.  000 
.  000 
.  000 
.  000 
.  000 
.0  00 
.000 
.000 
.  0  0  0 
.  000 
,000 
.  000 
.  001 
.  003 
.  073 
.281 
.  383 
.  468 
.  54  0 
.601 
.652 
.696 
.733 
.  764 
.  791 
.814 
.834 
.851 

.86b 

.879 
.890 
,900 
,9  09 
.916 
.923 
930 
.935 
.  940 
.945 
.949 
.952 


1  .  000 
1  .  000 
.  '^98 
.8  02 
.  684 
.645 
.607 
.567 
,529 
,492 
.458 
.427 

.401 

.380 
.  365 
.356 
.  353 
,  ''S? 
.371 
.396 
.436 
.497 
.538 
.  783 
.889 
.915 
.932 
,  944 
.954 
.961 
,  967 
,  971 
.975 
.978 
.  981 
.  983 
.985 

.  987 

.988 
.989 
,  990 
,  991 
.992 
.993 
.993 
.994 
.994 
.995 
,  995 
.995 


0-12. 

10.6 

94 , GHZ 

.  000 

1.00  0 

.  000 

1  .  000 

1.00  (. 

.  999 

.  ‘.■•  •:!'9 

i  .  0  0  0 

.941 

.  942 

.  901 

.9  03 

,996  ' 

.887 

,9^8 

.872 

.874 

.  997 

.856 

,859 

,  ■^97 

■  840 

.  Ysr 

.823 

.827 

.  '^96 

.807 

.811 

.792 

.796 

,  996  : 

.  779 

.  995 

.  768 

.772 

.  995 

.759 

.  763 

,  9S5 

.754 

.995 

752 

755 


762 

.76t. 

.  760 

797 

.800 

,  •*9b 

826 

.  829 

.  996 

865 

.  »b  .• 

.  YY. 

^35 

.  9“r 

, 

968 

.  969 

9 

976 

.976 

1  .  0  0  0 

981 

.981 

1  .  0  '.1  u 

984 

.  965 

1.00  Ij 

987 

.987 

■989 

.  ^89 

991 

.991 

992 

. 

1  Ij  0  0 

993 

.  993 

994 

.994 

995 

.995 

995 

.995 

996 

.■)96 

1  .u.iu 

996 

.  AAF 

997 

.  997 

1  .000 

997 

.  997 

1  .  ij  0  0 

997 

.997 

1  000 

998 

.996 

1  .  0  00 

998 

1  .  i.i  0  0 

998 

.  998 

1  0 u 

998 

.  99S 

1  0  0  0 

998 

.998 

1  0  00 

998 

.998 

1  uOO 

999 

.999 

1  0  0  0 

999 

.999 

999 

.  999 

1  0  0  0 

combined  EPFECT  of  2  EXECOTIOHS  IN  SMOKE; 
IftHNSWibSIOH 


SEC  > 

Cl 

0.4-0. 7  0 

7-1 .2 

Tf<HNSn] 
1  .  06 

bSIOH 
3.0-S.0  8 

0-12  , 

10.6 

84  .  CH.7 

. 

.  00 

f  .  000 

■  0  00 

1  .  000 

1  .  000 

.  OuO 

1  .  000 

1  .  0  C  0 

.  00 

1  .  000 

■  000 

1  .  000 

,  0  00 

1  .000 

1  .00  0 

1  5 . 

.  01 

.  848 

■  975 

.  999 

.  989 

1  .000 

20 . 

5.17 

.  000 

■  000 

.374 

.  764 

,  768 

.885 

25 . 

.  000 

HEEH 

.  000 

.270 

.688 

.704 

.  883 

30 . 

5.78 

.  000 

■  000 

.740 

.745 

.  884 

15  . 

5,21 

.  ooo 

^keeb 

.  f  6..^ 

.  767 

.  995 

40  . 

.  000 

.772 

.7.6 

.885 

45  . 

4  83 

.  000 

.  900 

■  392 

.774 

.776 

.895 

50 . 

.  000 

.  000 

■  385 

.770 

.  774 

885 

55. 

5.18 

■  000 

.000 

.374 

.  ^64 

.  769 

885 

5.37 

.  000 

.  000 

.756 

.  760 

.88t. 

S5 . 

5.57 

.  000 

.  000 

.000 

.  748 

.  753 

884 

70. 

5.75 

.  000 

.  000 

.000 

.  741 

.  74^ 

88'* 

75 . 

5 . 88 

.  000 

.736 

.741 

.  884 

SO . 

5.86 

.  000 

.734 

,736 

884 

S5. 

5.84 

.  000 

■  000 

.000 

.  734 

.  739 

.994 

.  000 

■  000 

.  000 

.331 

.738 

.  743 

884 

45 . 

5.58 

.  000 

.000 

.  000 

.346 

.  748 

.  754^ 

5.21 

.  000 

.000 

.  000 

.373 

.  763 

.  767 

885 

f  05. 

.  000 

.000 

.000 

.784 

.  768 

885 

1 1  0. 

3.86 

.  000 

.  000 

.  000 

.471 

.814 

.817 

886 

t  1 5 . 

3. 05 

.  000 

.  001 

.003 

.853 

.856 

887 

1  .52 

.  001 

.  036 

.045 

.824 

.825 

.886 

1  >5 

.84 

.  021 

.  158 

.178 

.957 

.856 

.  999 

130. 

.67 

.  046 

.228 

.  866 

.966 

,  999 

1  35 . 

.56 

.  076 

.282 

.  871 

•ts? 

.888 

.111 

.350 

.  875 

■  ^Z> 

1  000 

t45. 

.42 

.148 

■  4  02 

.428 

.978 

.979 

I  .  000 

150. 

,  37 

.  187 

.448 

■  474 

.833 

,98t 

t  .  000 

155. 

.32 

.226 

.492 

.515 

.840 

.983 

.984 

1 . 000 

160. 

.29 

■  264 

■  528 

.552 

.846 

.985 

.985 

1  .  OOf 

\n: 

.26 

.300 

.563 

.585 

.886 

1  .  ooc 

.24 

.335 

.583 

.614 

.  9l8 

.96b 

1  .  OOu 

175. 

.22 

■  366 

.621 

.641 

.858 

.  888 

,989 

1  .000 

180. 

.20 

.388 

.645 

■  664 

.963 

.990 

.  990 

1.000 

1  A5 

.  08 

.686 

.841 

.851 

.886 

.996 

1 .  ooc 

180 . 

.  07 

.723 

.857 

.866 

.996 

.886 

1  .000 

1 95 . 

.  06 

.748 

■  870 

.878 

.987 

.897 

1  .000 

.770 

■  882 

•  890 

.887 

.  ^87 

1  .ooc 

205 . 

.  05 

.788 

.883 

.800 

.990 

.  987 

.  997 

1  ooc 

.  05 

.806 

.902 

.908 

.891 

.  996 

.998 

1.00  0 

.  04 

■  822 

.911 

.816 

.892 

.996 

.988 

1  .Out 

220 . 

.  04 

.836 

.918 

.923 

.993 

.  996 

.996 

1  0 1.'  c 

^25  . 

.  04 

.849 

.925 

.930 

.993 

.988 

.998 

I  .Out 

210 

.  03 

.860 

.931 

■  935 

.884 

.886 

.  998 

1  000 

215  . 

.  03 

.  871 

■  936 

■  940 

.898 

.  996 

1  ooc 

.  03 

.880 

.941 

.945 

,  999 

.988 

1  .ooc 

^45 

.  03 

■  888 

.945 

.948 

.995 

,989 

.  889 

1  ,  0  0  c 

250. 

.  02 

.886 

.949 

.952 

.885 

.989 

.999 

I  .  0  V ' 

TRANSMISSION  RETURNEO  TO  MAIN  FOR  yAVELENCTH  OR  10.600  MICROMETERS  IS  .909  AT  TIME 


DIPT  TRANSMISSION  MODULE 


DIftTftAN-2  OUST  CLOUD  InFRhRED  TRANSMISSION 


ChlCUli^^TION 


♦  NOTE  --  hLL  units  aRE  MKS  UNLESS  OTHERWISE  SPECIFIED  *  *‘* 


pasouill  category 

2,00  temp  276.30  NT 
UiND  DIRECi ION 


2.00  UIND 
45 . 00 


latitude  53.00 

the  inversion  layer  height  is  crowing 

soil-2 

silt  content  .15 

DEfTri  OF  SOD  .00 

30  DEGREE  TILTED  TIP  AT  0.?  METER  DEPTH 
WEIGHT  OF  CHARGE  ,  b.60  KG. 

DETONATION  DEPTH  .00 

SIMULTANEOUS  BURST  .  UNIFORMLY  DISTRIBUTED  CHARGES  IN  A  PARALLELOGRAM 

otal  number  of  Charges  is  ,  i  with  reference  charge  at  <  .00.  oc 

1  charges  with  direction  AMD  SPACING  GIVEN  BY  (  .00,  .00> 

1  CHARGES  WITH  DIRECTION  AND  SPACING  GIVEN  BY  <  .00.  .00) 

ESTIMATED  INVERSION  HEIGHT  935 

time  after  BLAST  I . 00 


, ^wavelength  10.60  MICROMETERS 

TRAN'sMITTER  COOkOIMhTEs;  -4:00.00  .00  2. 00 

RECEIVER  COORDINATES  200.00  .00  2.00 

transmittance  along  the  line  of  sight  .767-002 

aerodynamic  cloud  MMENS20NS 


OBSERVER  coordinates  200.00 

THE  HEIGHT  OF  THE  CLOUD  IS  IS. 74 

THE  CENTROID  COuRDiNATtS  ARE  1.34 

THE  WIDTH  AT  THE  CENTROID  IS  20.62  M 

THE  WIDTH  AT  2.00  METERS  IS  i6.56 

6  CONTOUR  POINTS  HAVE  BEEN  DETERMINED 
-5.670  2.000 

-S  973  t 0.550 

1 . 537  1 9 . 74$ 

1.337  19.745 

11.646  10.550 

10.693  2.000 


.  uu 

19.74  METERS 
1.34  10.55 

20.62  METERS 
16.56  meters 


ESTIMATED  INVERSION  HEIGHT 


TIME  AFTER  BLAST 


wavelength  10.60  MICROMETERS 

TRANSMITTER  COORDINATES  -200  00  .00  2  00 

receiver  COOPDlNATtS  200  00  .00  2.00 

transmittance  along  the  line  of  sight  . 620+000 

aerodynamic  cloud  dimensions 


Uc  jER ver  coordinates 

THF  HEIGHT  OF  THE  CLOUD  IS 

the  centroid  coordinates  are 
the  width  at  the  centroid  is 

THE  WICTH  at  2.00  METERS  IS 


200.00  .00 

21  ,89  METERS 
8.02  10.55 

31.26  METERS 
21  .88  meters 


CuNTOUP  points  have  SEti*  DETERhlNEC' 
-2.947  2.000 

,  -7.608  1 0 . 550 


6t\f 


i 


3 . 9  06 
26 . 072 
28 . 072 
52 . 23 r 
46  659 


ie  550 

2t- ,  1  46 
26  1 46 
1 0.550 

2 . 0  0  U 


ESTIMATED  INVEftSlOh:  riEIuHT 


TIME  AFTER  0lA6T 


f  I  .  00 


UmVEuEnCTh  iO.feO  HiCPOMETtSb 

TRAHSM^TEF  COOFOIhMTES  -200-00  .00 

RECEI  Vtft  COOkC»1H«TES  20u  uO  .  Ou 

TRAN8MITTAHCE  Al ONC  THE  LINE  OF  SICHT  .999' 

AEPOOVNArtiC  Ol.O'.'C’  MrtENSIONf, 


0  00 


.  00 
.  Ou 


OBSERVER  COOROINATES 
THE  HEIGHT  OF  THE  ClOUC*  IS 
THE  CENTROrO  COOROIKATES  ARE 
THE  UlOTH  AT  THE  CENTROID  IS 
THE  WIDTH  AT  2.00  METERS  IS 


200 . 00 


6  CONTOUR  POINTS  HAVE  BE£H  DETERMINED 


,  0  0 

27.21  meters 
34.76  10.55 

52.30  nETEftS 
46.56  meters 


11.362 

6.607 

34.755 

34.755 

60.904 

57.944 


2.000 
10.550 
2  .  2 1  3 
27.213 
10.550 
2.000 


eSTIfitireC'  JWVERSIOW  HEIGHT  935 

TIME  AFTER  BlAST  13.00 


wavelength  10.60  MIcrOMETERS 

TRANSMITTER  COORDINATES  -200  00  .00 

RECEIVER  coordinates  200- 00  .00 

transmittance  along  The  line  of  sight  .100+001 
aerodvnamic  cloud  dimensions 


2-00 
2 . 00 


OBSERVER  COORDINATES 
THE  HEIGHT  OF  THE  CLOUD  IS 
THE  CENTROID  COORDIHATES  ARE 
THE  WIDTH  AT  THE  CENTROID  IS 
THE  WIDTH  AT  2.00  METERS  IS 


200  .  Cf  0 


6  CONTOUR  points  HAVE  BEEN  DETERMINED 


.  UO 

28.17  METERS 
41,44  1 0.5S 

55,82  METERS 
50.94  METERS 


15. 667 
13.529 
41 .439 
41 .439 
69.349 
66.605 


•  000 
1  0.550 

28.173 

28. 173 
1  0.550 

2.  OOO 


ESTIMATED  INVERSION  HEIGHT 


TIME  AFTER  BLAST 


15.00 


WAVELENGTH  10.60  MICROMETERS 

TRANSMITTER  COORDINATES  -200- 00  .00 

RECEIVER  coordinates  200.00  .00 

transmittance  along  The  LINE  OF  sight  .100+001 

aerodvnamic  Cloud  dimensions 


00 


observer  coordinates 

THE  HEIGHT  OF  THE  Ctui-C  IS 
THE  CENTROID  COORDINATES  ARE 
THE  WIDTH  AT  THE  CENTROID  IS 
THE  WIDTH  AT  2.0C  METERS  IS 


t*  0  0  .  M  0 


6  CONTOUR  points  HAVE  fcEEis  OErEFMlNED 


.  on 

05  METERS 
48.12  10.55 

59. 00  METERS 
55. 00  METERS 


CONTOUF;  P01WT&  HAVE  BEEN  DETERMINED 
33.434  2.000 

34.623  10.550 

bS. 174  31,315 

66.174  31,315 

101. 725  (0.550 

100.309  2.000 


ESTIMATED  INVERSION  HEIGHT 


TIME  AFTER  BLAST 


WAVELENGTH  10.60  MICROMETERS 

TRANSMITTER  COORDINATES  -200.00  .00 

RECEIVER  COORDINATES  200.00  .00 

TRANSMITTANCE  ALONG  THE  LINE  OF  SIGHT  .100+001 

AERODYNAMIC  CLOUD  DIMENSIONS 


OBSERVER  COORDINATES 
THE  HEIGHT  OF  THE  CLOUD  IS 
THE  CENTROID  COORDINATES  ARE 
THE  WIDTH  AT  THE  CENTROID  IS 
THE  WIDTH  AT  2.00  METERS  IS 


200.00  .00 

31.68  METERS 
74.86  10, 55 

66.44  METERS 
70.31  METERS 


CONTOUR  POINTS  HAVE  BEEN  DETERMINED 
38.032  2.000 

40.135  10.550 

74.858  31.977 

74.858  31.977 

109.580  10.550 

108.344  2.000 


ESTIMATED  INVERSION  HEIGHT 


TIME  AFTER  BLAST 


WAVELENGTH  10.60  MICROMETERS 

TRANSMITTER  COORDINATES  -200.00  .00  2.00 

RECEIVER  COORDINATES  200,00  .00  2.00 

TRANSMITTANCE  ALONG  THE  LINE  OF  SIGHT  ,100+001 

AERODYNAMIC  CLOUD  DIMENSIONS 


OBSERVER  COORDINATES 
THE  HEIGHT  OF  THE  CLOUD  IS 
THE  CENTROID  COORDINATES  ARE 
THE  WIDTH  AT  THE  CENTROID  IS 
THE  WIDTH  AT  2,00  METERS  IS 


0  .00 
32.60  METERS 
81.54  10.55 

71 .65  METERS 
73.75  METERS 


CONTOUR  POINTS  HAVE  BEEN  DETERMINED 
42.630  2.000 

45.717  10.550 

81 .541  32.603 

81.541  32.603 

117.366  10.550 

116.380  2.000 


estimated  INVERSION  HEIGHT 


TIME  AFTER  BLAST 


WAVELENGTH  10.60  MICROMETERS 

TRANSMITTER  COORDINATES  -200.00  .00 

RECEIVER  COORDINATES  200.00  .00 

TRANSMITTANCE  ALONG  THE  LINE  OF  SIGHT  .100+001 

AERODYNAMIC  CLOUD  DIMENSIONS 


OBSERVER  COORDINATES 
THE  HEIGHT  OF  THE  CLOUD  IS 
THE  CENTROID  COORDINATES  ARE 
THE  WIDTH  AT  THE  CENTROID  IS 


200.00  .00 

33.20  METERS 
88.23  10.55 

73.73  METERS 


THE  WIDTH  AT  THE  CEHTRCID  IS 
THE  WIDTH  AT  2.00  HETERS  IS 


79.38  METERS 
87. 19  meters 


CONTOUR  POIifTS  HAVE  BEEN  DETERMINED 


SO . 70i 
S6.58S 

1 06 . 275 

108.276 
147 .966 
147,896 


2.000 

1 0,550 

34.614 

34.614 
10,550 


ESTIMATED  INVERSION  HEIGHT 


TIME  AFTER  BLAST 


WAVELENGTH  10.60  MICROMETERS 

TRANSMITTER  COORDINATES  -200.00  .00 

RECEIVER  COORDINATES  200.00  ,00 

TRANSMITTANCE  ALONG  THE  LINE  OF  SIGHT  .100+001 

AERODYNAMIC  CLOUD  DIMENSIONS 


OBSERVER  COORDINATES 
THE  HEIGHT  OF  THE  CLOUD  IS 
THE  CENTROID  COORDINATES  ARE 
THE  WIDTH  AT  THE  CENTROID  IS 
THE  WIDTH  AT  2.00  METERS  IS 


200.00  .00 

35.31  METERS 

114.96  10.55 

81.10  METERS 

90.31  METERS 


CONTOUR  POINTS  HAVE  BEEN  DETERMINED 


65.306 
74.410 
114.960 
1 14.960 
155,510 
155,619 


2.000 

10.550 

35.308 

35.308 

10.550 

2.000 


ESTIMATED  INVERSION  HEIGHT 


TIME  AFTER  BLAST 


WAVELENGTH  10.60  MICROMETERS 

TRANSMITTER  COORDINATES  -200.00  .00 

RECEIVER  COORDINATES  200.00  .00, 

transmittance  ALONG  THE  LINE  OF  SIGHT  .100+001 

AERODYNAMIC  CLOUD  DIMENSIONS 


OBSERVER  COORDINATES 
THE  HEIGHT  OF  THE  CLOUD  IS 
THE  CENTROID  COORDINATES  ARE 
THE  WIDTH  AT  THE  CENTROID  IS 
THE  WIDTH  AT  2.00  METERS  IS 


}0  .00 
35.78  METERS 
121.64  10.55 

82,75  METERS 
93.75  METERS 


CONTOUR  POINTS  HAVE  BEEN  DETERMINED 


69.592 
80.271 
121 .644 
121 .644 
163.017 
163.342 


2 . 000 
1 0.550 
35.782 
35.762 
10.550 
2.000 


ESTIMATED  INVERSION  HEIGHT 


time  after  blast 


WAVELENGTH  10.60  MICROMETERS  _ 

TRANSMITTER  COORDINATES  -200.00  .00  2.00 

RECEIVER  COORDINATES  200.00  .00  2. 00 

TRANSMITTANCE  ALONG  THE  LIKE  OF  SIGHT  .100+001 

AERODYNAMIC  CLOUD  DIMENSIONS 


OBSERVER  coordinates 
THE  HEIGHT  OF  THE  CLOUD  IS 


.  00 

36.24  METERS 


THE  CENTROID  COOROIHHTES  ARE  (28,53  10.55 

THE  WIDTH  HT  THE  CENTROID  IS  84.33  METERS 

THE  WIDTH  AT  2.00  MEIERS  IS  96,86  METERS 

6  CONTOUR  POINTS  HAVE  BEEN  DETERMINED 
74.190  2.000 

66.164  10.550 

126.326  36.238 

123.326  36.233 

170,492  10,550 

171. 065  2.000 

ESTIMATED  INVERSION  HEIGHT  935 

TIME  AFTER  BLAST  41  .  00 


WAVELENGTH  10.60  MICROMETERS 

TRANSMITTER  COORDINATES  -200.00  .00  2.00 

RECEIVER  COORDINATES  200.00  .00  2.00 

TRANSMITTANCE  ALONG  THE  LINE  OF  SIGHT  .lOO+OOl 

AERODVHAMIC  CLOUD  DIMENSIONS 


OBSERVER  COORDINATES 
THE  HEIGHT  OF  THE  CLOUD  IS 
THE  CENTROID  COORDINATES  ARE 
THE  WIDTH  AT  THE  CENTROID  IS 
THE  WIDTH  AT  2.00  METERS  IS 


200. 00  . 00 

36.68  METERS 
135.01  10.55 

85.85  METERS 
100.00  METERS 


CONTOUR  POINTS  HAVE  BEEN  DETERMINED 
76.787  2.000 

92.086  10.550 

135.011  36.677 

135.011  36,677 

177.936  10.550 

178.787  2,000 


ESTIMATED  INVERSION  HEIGHT 


TIME  AFTER  BLAST 


WAVELENGTH  10.60  MICROMETERS 

TRANSMITTER  COORDINATES  -200.00  .00 

RECEIVER  COORDINATES  200.00  .00 

TRANSMITTANCE  ALONG  THE  LINE  OF  SIGHT  .100<-001 

AERODYNAMIC  CLOUD  DIMENSIONS 


OBSERVER  COORDINATES 
THE  HEIGHT  OF  THE  CLOUD  IS 
THE  CENTROID  COORDINATES  ARE 
THE  WIDTH  AT  THE  CENTROID  IS 
THE  WIDTH  AT  2.00  METERS  IS 


200.00  .00 

37.10  METERS 
141,70  10.55 

87.32  METERS 
102,81  METERS 


CONTOUR  POINTS  HAVE  BEEN  DETERMINED 
63.385  2.000 

96.037  10.550 

141.695  37,102 

141.695  37.102 

185,353  10.550 

136.198  2.000 


estimated  inversion  HEIGHT 


TIME  AFTER  BLAST 


WAVELENGTH  1 0 . 60  N ICROMETERS 

TRANSMITTER  COORDINATES  -200.00  .00  2.00 

RECEIVER  coordinates  200.00  .00  2,00 

TRANSMITTANCE  ALONG  THE  LINE  OF  SIGHT  .100+001 

AERODYNAMIC  CLOUD  DIMENSIONS 


OBSERVER 


COORDINATES 


200.00 


THE  HEIGHT  OF  THE  CLOUD  IS  ?7,;t  KETERS 

THE  CENTROID  COORDINATES  ARE  1 48 . 3S  10.55 

THE  WIDTH  AT  THE  CENTROID  IS  88,73  METERS 

THE  WIDTH  AT  2.00  METERS  IS  105.94  METERS 

6  CONTOUR  POINTS  HAVE  BEEN  DETERMINED 
67.983  2.000 

104.0)3  10.550 

146.379  37.512 

148.379  37.512 

192.745  10.550 

193.921  2.000 


ESTIMATED  INVERSION  HEIGHT 


935 


TINE  AFTER  BLAST 


47.00 


WAVELENGTH  1 0 . 60  MICROMETERS 

TRANSMITTER  COORDINATES  -200.00  .00  2.00 

RECEIVER  COORDINATES  200.00  .00  2.00 

TRANSMITTANCE  ALONG  THE  LINE  OF  SIGHT  .100+001 

AEfiODVHAMIC  CLOUD  DIMENSIONS 


OBSERVER  COORDINATES 
THE  HEIGHT  OF  THE  CLOUD  IS 
THE  CENTROID  COORDINATES  ARE 
THE  WIDTH  AT  THE  CENTROID  IS 
THE  WIDTH  AT  2.00  METERS 


IS 


200.00  .00 

37.91  METERS 
155.06  10.55 

90.10  METERS 
108.75  METERS 


6  CONTOUR  POINTS  HAVE  BEEN  DETERMINED 


92.581 
1)0.012 
155.063 
155 . 063 
200. 1)3 
201 .331 


2.000 

10.550 
37.909 
37.909 

10.550 

2.000 


ESTIMATED  INVERSION  HEIGHT  935 

TIME  AFTER  BLAST  49.00 


WAVELENGTH  10.60  MICROMETERS 

TRANSMITTER  COORDINATES  -200.00  .00  2.00 

RECEIVER  COORDINATES  200.00  .00  2.00 

TRANSMITTANCE  ALONG  THE  LINE  OF  SIGHT  .100+001 

AERODYNAMIC  CLOUD  DIMENSIONS 


OBSERVER  COORDINATES 
THE  HEIGHT  OF  THE  CLOUD  IS 
THE  CENTROID  COORDINATES  ARE 
THE  WIDTH  AT  THE  CENTROID  IS 
THE  WIDTH  AT  2.00  METERS 


IS 


200.00  .00 

38.29  METERS 
161.75  10.55 

91 ,43  METERS 
111,87  METERS 


6  CONTOUR  POINTS  HAVE  BEEN  DETERMINED 


97,179 
116.034 
161 .746 
161 .746 
207,459 
209.054 


2.000 

10.550 

38.293 

38.293 

10.550 

2.000 


ESTIMATED  INVERSION  HEIGHT  935 

TIME  AFTER  BLAST  51.00 


WAVELENGTH  10,60  MICROMETERS  „ 

TRANSMITTER  COORDINATES  -200.00  .00  2.00 

RECEIVER  COORDINATES  200.00  .00  2.00 

TRANSMITTANCE  ALONG  THE  LINE  OF  SIGHT  .100+001 


AERODYNAMIC  CLOUD  DIMENSIONS 


447 


AEftODtNAMIC  CLOUD  DIHEHCICH4 


OBSERVER  COORDINATES 
THE  HEIGHT  OF  THE  CLOUD  IS 
the  centroid  COORDINATES  ARE 
the  WIDTH  AT  THE  CENTROID  IS 
THE  WIDTH  AT  2.00  METERS  IS 
6  CONTOUR  POINTS  HAVE 
130.301 
156.700 

208.532 

206 . 532 
256 . 364 
260 . 826 


200 .00  .00 

40.69  METERS 
208.53  10.5 

99,66  METERS 
130.62  meters 
BEEN  DETERMINED 
2.000 

10.550 

40.691 

40.691 

10.550 

2.000 


ESTIMATED  INVERSION  HEIGHT  935 

TIME  AFTER  BLAST  65.00 


UAVELEHCTH 

TRANSMITTER  COORDINATES 
RECEIVER  COORDINATES 
TRANSMITTANCE  ALONG 


THE 


10.60  MICROMETERS 

-200.00  .00  2.00 

200. 00  . 00  2.  00 

LINE  OF  SIGHT  . 1 00+001 


AERODVNAHIC  CLOUD  DIMENSIONS 


OBSERVER  COORDINATES 
THE  HEIGHT  OF  THE  CLOUD  IS 
the  CENTROID  COORDINATES  ARE 
THE  WIDTH  AT  THE  CENTROID  IS 
THE  WIDTH  AT  2.00  METERS  IS 

6  CONTOUR  POINTS  HAVE  BEEN 
135.212 
164.857 
215.216 
215.216 
265.575 
268.337 


200.00  .00 

41 , 00  METERS 
215.22  10.55 

100.72  METERS 
133.12  METERS 
determined 
2. 000 
10.550 
40.998 
40.998 
10.550 
2. 000 


ESTIMATED  INVERSION  HEIGHT 


TIME  AFTER  BLAST 


935 


67.00 


WAVELENGTH  10.60  MICROMETERS 

TRANSMITTER  COORDINATES  -200.00  .00  2.00 

RECEIVER  coordinates  200.00  .00  2.00 

TRANSMITTANCE  ALONG  THE  LINE  OF  SIGHT  .100+001 

AERODYNAMIC  CLOUD  DIMENSIONS 


OBSERVER  coordinates 
THE  HEIGHT  OF  THE  CLOUD  IS 
THE  CENTROID  COORDINATES  ARE 
THE  WIDTH  AT  THE  CENTROID  IS 
THE  WIDTH  AT  2.00  METERS  IS 


200.00  .00 

41.30  METERS 
221.90  10.55 

1 01 .74  meters 
135. 00  METERS 


6  CONTOUR  POINTS  HAVE  BEEN  DETERMINED 


140.435 
171 . 026 
221 .900 
221 .900 
272,772 

275.435 


ESTIMATED  INVERSION  HEIGHT 


2.000 
1 0.550 
41  .298 
41.298 
10.550 
2.000 


TIME  AFTER  BLAST 


935 


69.00 


UAVEi.  EHGTH 

TRANSMITTER  COORDINATES  -200.00 

RECEIVER  COORDINATES  200. 00 

TRANSMITTANCE  ALONG  THE  LINE  OF  SIGHT 


10.60  micrometers 

.  .00 

OO 


.  1  00+001 


2.00 

2.00 
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INVERSE  static  TARGET  DETECTION  MODEL 
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AD-A114  417  ARMY  ELECTRONICS  RESEARCH  ANO  DEVELOPMENT  COMMAND  MS— ETC  F/a  i,/l 

PROGRAM  LISTINGS  FOR  EOSAEL  GO-B  ANO  ANCILLARY  CODES  AGAUS  ANn  —ETC  111) 
FCB  82  R  6  STeiNMOfp 

unclassified  eraocom/asl-tr-oio7<-v2-su  ml 


TOTAL  RADIANCE 


<WATTS  M-2  MICRON-i 

Sk-1  > 

WAVELENGTH 
CMICRONS  > 

WAVENUMBER  TARGET 

^CM-1  ; 

BACR'CROUNC' 

CONTRAST 

RATIO 

4.9751+000 

201  0 

1 .5362+000 

1 .6447+000 

-6 . 5959-002 

4.6309+000 

2070 

1 .3232+000 

1 .4094+000 

-6.11 79-002 

4.6946+000 

2(30 

( . (2(1+000 

1 .2059+000 

-7 . 0270-002 

4.5662+000 

2(90 

9.6050-001 

1 . 0274+000 

-6.511 1-002 

4.4444+000 

2230 

S. 4575-001 

6.6716-001 

-2 . 4691-002 

4.3290+000 

231  0 

7.3211-001 

7.3217-001 

-7.7684-005 

4.2(94+000 

2370 

6. (542-001 

6. (61 t-OOl 

-1 . 1 165-003 

4  .  (152+000 

2430 

5.1886-001 

5.3016-001 

-2 . 1316-002 

4.0(61+000 

2490 

4.6102-001 

4.5672-001 

9.4083-003 

3.92(6+000 

2550 

4. 1435-001 

3.9728-001 

4.2959-002 

3.83(4+000 

261  0 

3.7419-001 

3.4655-001 

7.9745-002 

3.7453+000 

2670 

3.2256-001 

2.8950-001 

1 . 1420-001 

0ETECT0R-PESPCK5E  UAVELEHGTH- INTEGRATED 


<UftTTS  M-2  SR-1> 

TARGET  eniSStOH 

TARGET  REFLECTANCE 

PARTIAL  ATMOSPHERIC  EMISSION 

PARTIAL  PATH  RADIANCE 

TOTAL  target  RADIANCE 

GROUND  EMISSION 

GROUND  REFLECTANCE 

TOTAL  ATMOSPHERIC  EMISSION 

TOTAL  PATH  RADIANCE 

TOTAL  BACKGROUND  RADIANCE 


4.9)17-002 
1 .8157-003 
4 . 3029-002 
7. 7395-005 
9.4039-002 
.  0000 
.  0000 

9.7352-002 
9 . I  328-004 
9.82S5-002 


4i  igi  4i  9*  41  ill  41  *  *  4t  «  Hr  4i  9|i  •  «  *  «  %  4i  4t  ♦  « >ti «  4i  4i « i«ii»  %  *  lit  * 

CONTRAST  -4 .3004-002 

«  41 «  «  4i «  4i  4i «  4i  4i  4i  4i  4i  4i  4i  4*  4i  4i  4i  *  *  4i  4i  4i  4i  4i  4(  ♦ )«» 4i  4i  4i  *  4i  4i  4i  4i  4i  4i  4i 


DIRECT  SUNLIGHT  .0000 

<UATTS  M-2j 


) 
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LT4M  kTMOSPHERIC  TRAHSMISSIOH  MODULt 
PROGRAM  WILL  BE  EXECUTED  IN  THE  TRANSMISSION  MODE 

HORIZONTAL  PATH,  ALTITUDE  -  .002  KM, RANGE  -  .400  KM 

MODEL  ATMOSPHERE  4  -  SUB- ARCTIC  SUMMER 

FREQUENCY  RANGE  V1=  2010.0  CM-1  TO  V2-  2710.0  CM-1  FOR  DV  >  60.0  CM-1  <  3.69  -  4.96  MICRONS  • 

EQUIVALENT  SEA  LEVEL  ABSORBER  AMOUNTS 

MOL  SCAT  OZONEt 

KM  ATM  CM 

.380*000  .915- 


.707-004 


WATER  VAPOUR 
GM  CM-2 


«<'  1-6,8  >» 

U<  1  0>« 


,355*000 


C02  ETC. 

KM 

.372*000 


OZONE 
ATM  CM 


.905-003 


NITROGEN  <CONT) 
RM 

,295*000 


H20  ICONTT 
GM  CM-2 

.595-002 

.546-001 


W<ll-I6)« 


NITRIC  ACID 

.000 


$02 

.634-002 


HH3 

.779-002 


H02 

.337-002 


.433-002 


IJ-V  » 
003 


FREQ 
CM-! 
20!  0 
2070 
2130 
2t90 
2250 
231  0 
2370 
2430 
2490 
2550 
2610 
2670 


y^VELENCTH 
MICRONS 
4 . 9751 
4  9309 
4 . 6949 
4.5662 
4 .4444 
4,3290 
4.2194 
4.1152 
4.0161 
3.9216 
3.9314 
3.7453 


H20 

TR9NS 

.6090 

.7608 

.9649 

.9399 

.9367 

.9769 

.9925 

.9977 

.9996 

.9903 

.9663 

.9383 


C02+ 

TRANS 

.  9997 

.9529 

.9953 

.9313 

.3230 

.  001 1 

.0172 

.9941 

.9941 

.9768 

.9985 

.9961 


OZONE 
TRANS 
1  .  0000 
.9996 
.9990 
1  .0000 
1  .  0000 
1  .  0000 
1  .  0000 
1  .  0000 
1  .0000 
1  .  0000 
1  .0000 
1  .0000 


N2  C 
TRANS 
1  .0000 
1  .0000 
.9990 
.9915 
.9607 
.9652 
.9675 
.9723 
.9690 
.9972 
.9993 
.9996 


H20  C 
TRANS 
1  .  0000 
.822  0 
.9066 
1  .0000 
1  .  0000 
1  .  0000 
.9791 
.9948 
.9890 
.9916 
.9925 
.9916 


yAVELENGTH  AND  SENSOR  INTEGRATED  TRANSMISSION 
INTEGRATED  ASORPTION  FROM  2010  TO  2730  CM-I 


MOL  S 
TRANS 
1 .0000 
1 .0000 
1 . uuvO 
1 . 0000 
1 . 0000 
1 .0000 
1  . 0000 
1 .0000 
1.0000 
1.0000 
1 .0000 
1 . 0000 


NITRIC 
TRANS 
t  .  0000 
1  .  OGOO 
1  .  OGOO 
1  .  0000 
f  .  0000 
1 .0000 
1  .0000 
1  .0000 
1 . 0000 
1  .  0000 
1  .0000 
1 . 0000 


S02 
TRANS 
0000 
0000 
0000 
0000 
0000 
0000 
0000 
.  0000 
.9971 
1  .  0000 
1 . 0000 
1  .  0000 


HN03 
TRANS 
1  .  OuOO 
.  0000 
.0000 
.  0000 
.  0000 
.  000  0 
.0000 
.  0000 
.  0000 


.4711-601 

262. 22>  AVERAGE  TRANSMITTANCE 


1 . 0000  1 


.  0000 
.  0000 


N02 

TRANS 

0000 

0000 

0000 

0000 

uOuO 

0000 

0000 

0000 

0000 

0000 

0000 

0000 


INTEGRATED 

ABSORPTION 

12.6982 

38.8084 

54.9334 

70.8646 

113.9951 

173.9270 

233.0067 

238.9729 

243.9880 

249.4692 

255.0312 

262.2208 


TOTAL 
TRANS 
.5767 
.5648 
.7313 
.7345 
.2913 
.0010 
.  0153 
.9006 
.9181 
.9070 
.9073 
.9802 


aerosol 

TRANS 
.  94820 
. 94820 
. 94 82 U 
. 9482  0 
.  94820 
.  94820 
.94820 
.  9482  0 
. 94820 
. 94820 
. 94820 
.94820 


.6358 
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LT4H  ATMOSPHERIC  TRAHSMISSIOH  MODULE 
PROGRAM  WILL  BE  EXECUTED  IN  THE  EMISSION  MODE 


HORIZONTAL  PATH,  ALTITUDE  =  .002  KM, RANGE  =  .400  KM 

MODEL  ATMOSPHERE  4  =  SUB-ARCTIC  SUMMER 

PREQUENCV  RANGE  VI =  20)0.0  CM-1  TO  V2-  2?) 0.0  CM-I  FOR  DV  -  SO . 0  CM-1  <  3.69 

EQUIVALENT  SEA  LEVEL  ABSORBER  AMOUNTS 

WATER  VAPOUR  002  ETC.  020NE  NITROGEN  < CONT >  H20  < CONT ) 

GM  CM-2  KM  ATM  CM  KM  GM  CM-2 

U< 1-6,8)*  .355+000  .372+000  .905-003  ,295+000  ,595-002 

y<  t  0 )•  .546-001 


4.9&  MICRONS  • 

MOL  SCAT  uZONEiu-Vi 

KM  ATM  CM 

.380+000  ,9)5-003 


NITRIC  ACID 


CUMULATIVE  ABSORBER  AMOUNTS  FOR  THE  ATMOSPHERIC  PATH 

H20  C02+  03  N2  H20  C  MOL  S  03  UV  H20  C  HN03  S02 

1  .355+000  ,372+000  .905-003  .295+000  .595-002  .380+000  .915-003  .546-001  .000  .834-002 


HH3  H02 

.779-002  .337-002 


TAVE 
287 . 000 


FRi:  CM-t  ) 

2010.0 
2070.0 
2130.0 
2190.0 
2250.0 
2310.0 
2370.0 
2430.0 
2490.0 
2350. 0 
2610.0 
2670.0 


RACiI9NCE<  UATTS/'CH2-STER-XXX  ) 
UVL(niCRQN>  PER  CM-1  PER  MICRON 


4.975124 

4.630916 

4.694636 

4.366210 

4.444444 

4.329004 

4.219409 

4.115226 

4.016064 

3.921369 

3.831416 

3.745318 


.17216-006 
. 14311-006 
.71276-007 
.56657-007 
.1231 0-006 
.13708-006 
.10801-006 
.87026-008 
.37098-008 
.51349-008 
.40774-008 
.41768-008 


urvelength  and  sensor  intecrrted  transmission 


RAOMIN 

RADMAX 


2610.000 

2010.000 


.40774-008 

.17216-006 


.69555-004 

.61320-004 

.32337-004 

.27173-004 

.62320-004 

.73146-004 

.60666-004 

.31388-005 

.35402-005 

.33520-005 

.27776-005 

.29776-005 

•  .4711-001 


INTECRhL 

.51648-005 
.  13751-004 
.18028-004 
.21427-004 
.26813-004 
.37038-004 
.43516-004 
.44040-004 
.44383-004 
.44692-004 
.44937-004 
.45186-004 


TRANS  - 

.576727 

.564830 

.731250 

.734479 

.281325 

.000967 

.015339 

.900563 

.918063 

.906979 

.907301 

.880173 


—  AERO 
EXTN 
.94820 
.94820 
.94820 
.94820 
. 94820 
. 94820 
.94820 
.94820 
. 94820 
.94820 
.94820 
.94820 


integrated  ASORPTION  from  2010  TO  2730  CM-1 
INTEGRATED  RADIANCE  •  .45188-004  MATT  CM  -2 


8R 


262.22.  AVERAGE  TRANSHITTANCE  «  .6358 


TRAN - 

ABS 
.98942 
.98942 
.98942 
.98942 
. 96942 
, 98942 
.98942 
.98942 
. 98942 
.98942 
.98942 
.98942 


COMBINED  TRANSMISSION  FOR  THE  SELECTED  MODULES  «  .4711-001 


END  EOSAEL  RUN 


CO 

<T> 


( 


ELECTRO-OPTICS  DISTRIBUTION  LIST 


Comander 

US  Amy  Aviation  School 
Fort  Rucker,  AL  36362 

Comnander 

US  Amty  Aviation  Center 

AHN:  ATZQ-D-MA  (Mr.  Oliver  N.  Heath) 

Fort  Rucker,  AL  36362 

Commander 

US  Army  Aviation  Center 

ATTN:  ATZQ-D-MS  (Mr.  Donald  Wagner) 

Fort  Rucker,  AL  36362 

NASA/Marshall  Space  Flight  Center 
ATTN:  ES-83  (Otha  H.  Vaughan,  Jr.) 
Huntsville,  AL  35812 

NASA/Marshall  Space  Flight  Center 
Atmospheric  Sciences  Division 
ATTN:  Code  ES-81  (Dr.  William  W.  Vaughan) 
Huntsville,  AL  35812 

Nichols  Research  Corporation 
ATTN:  Or.  Lary  W.  Pinkley 
4040  South  Memorial  Parkway 
Huntsville,  AL  35802 

John  M.  Hobble 

c/o  Kentron  International' 

2003  Byrd  Spring  Road 
Huntsville,  AL  35802 

Mr.  Ray  Baker 

Lockheed-Missile  A  Space  Company 
4800  Bradford  Blvd 
Huntsville,  AL  35807 

Commander 

US  Am^  Missile  Command 

ATTN:  DRSMI-OG  (Mr.  Donald  R.  Peterson) 

Redstone  Arsenal,  AL  35809 

Commander 

US  Amy  Missile  Command 

AHN:  ORSMI-OGA  (Dr.  Bruce  W.  Fowler) 

Redstone  Arsenal,  AL  35809 


Commander 

US  Am^  Missile  Command 

ATTN:  ORSMI-REL  (Dr.  George  Emmons) 

Redstone  Arsenal.  AL  35809 

Commander 

US  Amy  Missile  Command 

ATTN:  DRSMI-REO  (Huey  F.  Anderson) 

Redstone  Arsenal,  AL  35809 

Commander 

US  Arn^  Missile  Command 

ATTN:  DRSMI-REO  (Mr.  Maxwell  W.  Harper) 

Redstone  Arsenal,  AL  35809 

Commander 

US  Army  Missile  Command 

ATTN:  DRSMI-REO  (Mr.  Gene  Widenhofer) 

Redstone  Arsenal,  AL  35809 

Commander 

US  Army  Missile  Command 

ATTN:  ORSMI-RHC  (Or.  Julius  Q.  Lilly) 

Redstone  Arsenal,  AL  35809 

Commander 

US  Army  Missile  Command 
Redstone  Scientific  Information  Center 
ATTN:  DRSMI-RPRD  (Documents  Section) 
Redstone  Arsenal,  AL  35809 

Commander 

US  Army  Missile  Command 

ATTN:  DRSMI-RRA  (Dr.  Oskar  Essenwanger) 

Redstone  Arsenal,  AL  35809 

Commander 

US  Amy  Missile  Command 

ATTN:  DRSMI-RRO  (Mr.  Charles  Christensen) 

Redstone  Arsenal,  AL  35809 

Commander 

US  AriRy  Missile  Command 

ATTN:  DRSMI-RRO  (Dr.  George  A.  Tanton) 

Redstone  Arsenal,  AL  35809 


i 


SRI  International 
ATTN:  Mr.  J.  E.  Van  der  Laan 
333  Ravenswood  Avenue 
Menlo  Park.  CA  94025 

Joane  May 

Naval  Environmental  Prediction 
Research  Facility  (MEPRF) 

ATTN:  Library 
Monterey,  CA  93940 

Sylvania  Systems  Group, 

Western  Division 
GTE  Products  Corporation 
ATTN:  Technical  Reports  Library 
P.O.  Box  205 

Mountain  View,  CA  94042 

Sylvania  Systems  Group 
Western  Division 
GTE  Products  Corporation 
ATTN:  Mr.  Lee  W.  Carrier 
P.O.  Box  188 

Mountain  View,  CA  94042 

Pacific  Missile  Test  Center 
Geophysics  Division 
ATTN:  Code  3250-3  (R.  de  Viollnl) 
Point  Mugu,  CA  93042 


Commander 

US  Amy  Communications  Command 

ATTN:  CC-OPS-PP 

Fort  Huachuca,  AZ  85613 

Commander 

US  Army  Intelligence  Center  A  School 
ATTN:  ATSI-CO-CS  (Mr.  Richard  G.  Cun<Iy) 
Fort  Huachuca,  AZ  85613 

Commander 

US  Army  Intelligence  Center  A  School 
ATTN:  ATSI-CD-MD  (Mr.  Harry  Wilder) 
Fort  Huachuca,  AZ  85613 

Commander 

US  Army  Intelligence  Center  A  School 
ATTN:  ATSl-CS-C  (2LT  Coffman) 

Fort  Huachuca,  AZ  85613 

Commander 

US  Amy  Yuma  Proving  Ground 
ATTN;  STEYP-MSA-TL 
Bldg  2105 
Yuma,  AZ  85364 

Northrop  Corporation 
Electro-Mechanical  Division 
ATTN:  Dr.  Richard  D.  Tooley 
500  East  Orangethorpe  Avenue 
Anaheim,  CA  92801 

Commander 

Naval  Weapons  Center 

ATTN;  Code  3918  (Dr.  Alexis  Shlanta) 

China  Lake,  CA  93555 

Hughes  Helicopters 

Amy  Advanced  Attack  Helicopter  Weapons 
AHN:  Mr.  Charles  R.  Hill 
Centinela  and  Teale  Streets 
Bldg  305,  MS  T-73A 
Culter  City,  CA  90230 

Commander 

US  Amy  Combat  Developments 
Experimentation  Command 
AHN:  ATEC-PL-M  (Mr.  Gary  G.  Love) 

Fort  Ord,  CA  93941 

SRI  International 
AHN:  K2060/Dr.  Edward  E.  Uthe 
333  Ravenswood  Avenue 
Menlo  Park,  CA  94025 


Pacific  Missile  Test  Center 
Geophysics  Division 
ATTN;  Code  3253  (Terry  E.  Battalino) 
Point  Mugu,  CA  93042 


Commander 

Naval  Ocean  Systems  Center 

ATTN:  Code  532  (Dr.  Juergen  Richter) 

San  Diego,  CA  92152 

Commander 

Naval  Ocean  Systems  Center 

AHN:  Code  5322  (Mr.  Herbert  G.  Hughes) 

San  Diego,  CA  92152 

Commander 

Naval  Ocean  Systems  Center 

ATTN:  Code  4473  (Tech  Library)  ) 

San  Diego,  CA  92152 


Effects  Technology  Inc. 
ATTN:  Mr.  John  D.  Carlyle 
5383  Hollister  Avenue 
Santa  Barbara,  CA  93111 
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The  RAND  Corporation 
ATTN:  Ralph  Huschke 
1700  Main  Street 
Santa  Monica,  CA  90406 

Particle  Measuring  Systems,  Inc. 

ATTN:  Dr.  Robert  G.  Knoll enberg 
1855  South  57th  Court 
Boulder,  CO  80301 

US  Department  of  Commerce 
National  Oceanic  and  Atmospheric  Admin 
Environmental  Research  Laboratories 
ATTN:  Library,  R-51,  Technical  Reports 
325  Broadway 
Boulder,  CO  80303 

US  Department  of  Commerce 
National  Oceanic  and  Atmospheric  Admin 
Environmental  Research  Laboratories 
ATTN:  R45X3  (Or.  Vernon  E.  Derr) 
Boulder,  CO  80303 

US  Department  of  Commerce 
National  Telecommunications  and 
Information  Administration 
Institute  for  Telecommunication  Sciences 
ATTN:  Code  1-3426  (Or.  Hans  J.  Liebe) 
Boulder,  CO  80303 

AFATL/OLOOL 
Technical  Library 
Eg! in  AFB,  FL  32542 

Commanding  Officer 
Naval  Training  Equipment  Center 
ATTN:  Technical  Information  Center 
Orlando,  FL  32813 

Georgia  Institute  of  Technology 
Engineering  Experiment  Station 
ATTN:  Dr.  Robert  W.  McMillan 
Atlanta,  GA  30332 

Georgia  Institute  of  Technology 
Engineering  Experiment  Station 
ATTN:  Dr.  James  C.  Wiltse 
Atlanta,  GA  30332 

Commandant 

US  Amy  Infantry  Center 

ATTN:  ATSH-CO-MS-E  (Mr.  Robert  McKenna) 

Fort  Benning,  GA  31805 


Commander 

US  Army  Signal  Center  &  Fort  Gordon 
ATTN:  ATZHCD-CS 
Fort  Gordon,  GA  30905 

Commander 

US  Arny  Signal  Center  S  Fort  Gordon 

ATTN:  ATZHCD-O 

Fort  Gordon,  GA  30905 

USAFETAC/DNE 

ATTN:  Mr.  Charles  Glauber 
Scott  AFB,  IL  62225 

Commander 

Air  Weather  Service 

ATTN:  AWS/DNDP  (LTC  Kit  G.  Cottrell) 

Scott  AFB,  IL  62225 

Commander 

Air  Weather  Service 

ATTN:  AWS/DOOF  (MW  Robert  Wright) 

Scott  AFB,  IL  62225 

Commander 

US  Army  Combined  Arms  Center 
i  Ft.  Leavenworth 

ATTN:  ATZLCA-CAA-Q  (Mr.  H.  Kent  Pickett) 
Fort  Leavenworth,  KS  66027 

Commander 

US  Army  Combined  Arms  Center 
S  Ft.  Leavenworth 

ATTN:  ATZLCA-SAN  (Robert  DeKinder,  Jr.) 
Fort  Leavenworth,  KS  66027 

Commander 

US  Amy  Combined  Arms  Center 
S  Ft.  Leavenworth 

ATTN:  ATZLCA-SAN  (Mr.  Kent  I.  Johnson) 
Fort  Leavenworth,  KS  66027 

Commander 

US  Amy  Combined  Arms  Center 
S  Ft.  Leavenworth 

ATTN:  ATZLCA-WE  (LTC  Darrell  Holland) 
Fort  Leavenworth,  KS  66027 

President 

USAARENBD 

ATTN:  ATZK-AE-TA  (Dr.  Charles  R.  Leake) 
Fort  Knox,  KY  40121 
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Comnander 

US  Army  Armor  Center  and  Fort  Knox 
ATTN:  ATZK-CO-MS 
Fort  Knox,  KY  40121 

Commander 

US  Amy  Armor  Center  and  Fort  Knox 
ATTN:  ATZK-CD-SD 
Fort  Knox.  KY  40121 

Aerodyne  Research  Inc. 

ATTN:  Dr.  John  F.  Ebersole 
Crosby  Drive 
Bedford.  MA  01730 

Commander 

Air  Force  Geophysics  Laboratory 
ATTN:  OPA  (Dr.  Robert  W.  Fenn) 

Hanscom  AFB,  MA  01731 

Commander 

Air  Force  Geophysics  Laboratory 
ATTN:  OPI  (Or.  Robert  A.  McClatchey) 
Hanscom  AFB,  MA  01731 

Massachusetts  Institute  of  Technology 

Lincoln  Laboratory 

ATTN;  Or.  T.  J.  Goblick,  B-370 

P.O.  Box  73 

Lexington,  MA  02173 

Massachusetts  Institute  of  Technology 

Lincoln  Laboratory 

ATTN:  Or.  Michael  Gruber 

P.O.  Box  73 

Lexington,  MA  02173 

Raytheon  Company 

Equipment  Division 

ATTN:  Dr.  Charles  M.  Sonnerischein 

430  Boston  Post  Road 

Wayland,  MA  01778 

Commander 

US  Amy  Ballistic  Research  Laboratory/ 
ARRADCOM 

ATTN:  DRDAR-BLB  (Mr.  Richard  McGee) 
Aberdeen  Proving  Ground,  MD  21005 


Conmander/Di rector 
Chemical  Systems  Laboratory 
US  Amy  Armament  Research 
A  Development  Command 
AHN:  DRDAR-CLB-PS  (Dr.  Edward  Stuebing) 
Aberdeen  Proving  Ground,  MD  21010 

Commander/Director 
Chemical  Systems  Laboratory 
US  Amy  Armament  Research 
A  Development  Command 
ATTN:  DRDAR-CLB-PS  (Mr.  Joseph  Vervler) 
Aberdeen  Proving  Ground,  MD  21010 

Commander/Di  rector 
Chemical  Systems  Laboratory 
US  Amy  Armament  Research 
A  Development  Command 
ATTN:  DRDAR-CLY-A  (Mr.  Ronnald  Pennsyle) 
Aberdeen  Proving  Ground,  MD  21010 

Commander 

US  Amy  Ballistic  Research  Laboratory/ 
ARRADCOM 

ATTN:  DRDAR-TSB-S  (STINFO) 

Aberdeen  Proving  Ground,  MD  21005 

Commander 

US  Amy  Electronics  Research 
A  Development  Command 
ATTN:  DRDEL-CCM  (W.  H.  Pepper) 

Adel phi,  MD  20783 

Commander 

US  Amy  Electronics  Research 
A  Development  Command 
ATTN:  DRDEL-CG/DRDEL-DC/DRDEL-CS 
2800  Powder  Mill  Road 
Adel phi,  «)  20783 

Commander 

US  Amy  Electronics  Research 
A  Development  Command 
ATTN:  ORDEL-CT 
2800  Powder  Mill  Road 
Adel phi.  M)  20783 

Commander 

US  Amy  Electronics  Research 
A  Development  Command 
ATTM:  ORDEL-PAO  (M.  Singleton) 

2800  Powder  Mill  Road 
Adel phi,  MD  20783 
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Project  Manager 
Smoke/Obscurants 
AHN;  DRDPM-SMK 

(Dr.  Anthony  Van  de  Wal ,  Jr.) 
Aberdeen  Proving  Ground,  MD  21005 

Project  Manager 
Smoke/Obscurants 

ATTN:  DRDPM-SMK-T  (Mr.  Sidney  Gerard) 
Aberdeen  Proving  Ground,  MD  21005 

Commander 

US  Arny  Test  &  Evaluation  Command 
ATTN;  DRSTE-AD-M  (Mr.  Warren  M.  Baity) 
Aberdeen  Proving  Ground,  MD  21005 

Commander 

US  Army  Test  &  Evaluation  Command 
ATTN:  DRSTE-AD-M  (Dr.  Norman  E.  Pentz) 
Aberdeen  Proving  Ground,  MD  21005 

Director 

US  Army  Materiel  Systems  Analysis  Activity 
ATTN:  DRXSY-AAM  (Mr.  William  Smith) 
Aberdeen  Proving  Ground,  MD  21005 

Director 

US  Army  Materiel  Systems  Analysis  Activity 
ATTN:  ORXSY-CS  (Mr.  Philio  H.  Beavers) 
Aberdeen  Proving  Ground,  MO  21005 

Di rector 

US  Army  Materiel  Systems  Analysis  Activity 
ATTN:  DRXSY-GB  (Wilbur  L.  Warfield) 
Aberdeen  Proving  Ground,  MD  21005 

Di rector 

US  Army  Materiel  Systems  Analysis  Activity 
ATTN:  DRXSY-GP  (Mr.  Fred  Campbell) 

Aberdeen  Proving  Ground,  MO  21005 

Director 

US  Artry  Material  Systems  Analysis  Activity 
AHN:  DRXSY-GP  (H.  Stamper) 

Aberdeen  Proving  Grounds,  MD  21006 

Director 

US  Army  Materiel  Systems  Analysis  Activity 
ATTN:  ORXSY-GS 

(Mr.  Michael  Starks/Mr.  Julian  Chernick) 
Aberdeen  Proving  Ground,  MO  21005 


Di rector 

US  ^rmy  Materiel  Systems  Analysis  Activity 
ATTN:  DRXSY-J  (Mr  James  F.  O'Bryon) 
Aberdeen  Proving  Ground,  MD  21005 

Director 

US  Army  Materiel  Systems  Analysis  Activity 
ATTN:  DRXSY-LM  (Mr.  Robert  M.  Marchetti ) 
Aberdeen  Proving  Ground,  MD  21005 

Commander 

Harry  Diamond  Laboratories 
ATTN;  Dr.  William  W.  Carter 
2800  Powder  Mill  Road 
Adel  phi,  MD  20783 

Commander 

Harry  Diamond  Laboratories 
ATTN:  DELHD-R-CM  (Mr.  Robert  McCoskey) 
2800  Powder  Mill  Road 
Adel  phi,  MD  20783 

Commander 

Harry  Diamond  Laboratories 
ATTN:  OELHD-R-CM-NM  (Dr.  Robert  Humphrey) 
2800  Powder  Mill  Road 
Adel  phi,  MD  20783 

Commander 

Harry  Diamond  Laboratories 
ATTN;  DELHD-R-CM-NM  (Dr.  Z.  6.  Sztankay) 
2800  Powder  Mill  Road 
Adel  phi,  MO  20783 

Commander 

Harry  Diamond  Laboratories 
ATTN;  DELHD-R-CM-NM  (Dr.  Joseph  Nemarich) 
2800  Powder  Mill  Road 
Adel  phi,  MD  20783 

Commander 

Air  Force  Systems  Command 

ATTN:  WER  (Mr.  Richard  F.  Picanso) 

Andrews  AFB,  MD  20334 

Martin  Marietta  Laboratories 
ATTN;  Jar  Mo  Chen 
1450  South  Rolling  Road 
Baltimore,  MD  21227 
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Commander 

US  Amy  Concepts  Analysis  Agency 
ATTN:  CSCA-SMC  (Mr.  Hal  E.  Hock) 

8120  Woodmont  Avenue 
Bethesda,  MD  20014 

Director 

National  Security  Agency 
ATTN:  R52/0r.  Douglas  Woods 
Fort  George  G.  Meade,  MD  20755 

Chief 

Intelligence  Materiel  Development 

5  Support  Office 

US  Army  Electronic  Warfare  Laboratory 
ATTN:  DELEW-I  (LTC  Kenneth  E.  Thomas) 
Fort  George  G.  Meade,  MD  20755 

The  Johns  Hopkins  University 
Applied  Physics  Laboratory 
ATTN:  Dr.  Michael  J.  Lun 
John  Hopkins  Road 
Lauren,  MD  20810 

Or.  Stephen  T.  Hanley 
1720  Rhodesia  Avenue 
Oxon  Hill,  M)  20022 

Science  Applications  Inc. 

ATTN:  Mr,  G.  0.  Currie 
15  Research  Drive 
Ann  Arbor,  MI  48103 

Scence  Applications  Inc. 

ATTN:  Or.  Robert  E,  Turner 
15  Research  Drive 
Ann  Arbor,  MI  48103 

Commander 

US  Army  Tank -Automotive  Research 

6  Development  Command 

ATTN:  DRDTA-ZSC  (Mr.  Harry  Young) 
Warren,  MI  48090 

Commander 

US  Army  Tank  Automotive  Research 
&  Development  Command 
ATTN:  DRDTA-ZSC  (Mr.  Wallace  Mick,  Jr.) 
Warren,  MI  48090 


Dr.  A.  D.  Belmont 
Research  Division 
Control  Data  Corporation 
P.O.  Bo.x  1249 
Minneapolis,  MN  55440 

Director 

US  Ar%  Engr  Waterways  Experiment  Station 
ATTN:  WESEN  (Mr.  James  Mason) 

P.O.  Box  631 
Vicksburg,  MS  39180 

Or.  Jerry  Davis 
Department  of  Marine,  Earth 
and  Atmospheric  Sciences 
North  Carolina  State  University 
Raleigh,  NC  27650 

Commander 

US  Army  Research  Office 

ATTN:  DRKRO-GS  (Dr.  Leo  Alpert) 

P.O.  Box  12211 

Research  Triangle  Park,  NC  27709 
Commander 

US  Army  Research  Office 
AHN:  DRXRO-PP  (Brenda  Mann) 

P.O.  Box  12211 

Research  Triangle  Park,  NC  27709 
Commander 

US  Army  Cold  Regions  Research 
S  Engineering  Laboratory 
ATTN:  CRREL-RD  (Dr.  K.  F.  Sterrett) 
Hanover,  NH  03755 

Commander/Di  rector 
US  Arny  Cold  Regions  Research 
A  Engineering  Laboratory 
ATTN:  CRPEL-RG  (Mr.  George  Aitken) 
Hanover,  NH  03755 

Commander 

US  Amy  Cold  Regions  Research 
4  Engineering  Laboratory 
ATTN:  CRREL-RG  (Mr.  Roger  H.  Berger) 
Hanover,  NH  03755 

Commander 

US  Amy  Armament  Research 
4  Development  Command 
ATTN:  ORDAR-AC  (Mr.  James  Greenfield) 
Dover,  NJ  07801 
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Conmander 

US  Army  Armament  Research 
it  Development  Command 
ATTN:  DRDAR-TSS  (Bldg  #59) 

Dover,  NJ  07801 

Commander 

US  Army  Armament  Research 
4  Development  Command 
ATTN:  DRCPM-CAWS-EI  (Mr.  Peter is  Jansons) 
Dover,  NJ  07801 

Commander 

US  Army  Armament  Research 
&  Development  Command 
ATTN:  DRCPM-CAWS-EI  (Mr.  G.  H.  Waldron) 
Dover,  NJ  07801 

Deputy  Joint  Project  Manager 
for  Navy/USMC  SAL  GP 

ATTN:  DRCPM-CAWS-NV  (CPT  Joseph  Miceli) 
Dover,  NJ  07801 

Cormiander/Oi  rector 
IS  Army  Combat  Surveillance  4  Target 
Acquisition  Laboratory 
ATTN;  DELCS-I  (Mr.  David  Longinotti) 

Fort  Monmouth,  NJ  07703 

Commander/Oi rector 

US  Army  Combat  Surveillance  4  Target 
Acquisition  Laboratory 
ATTN;  DELCS-PE  (Mr.  Ben  A.  Di  Campli) 

Fort  Monmouth,  NJ  07703 

Commander/Oi rector 

US  Army  Combat  Surveillance  4  Target 
Acquisition  Laboratory 
ATTN:  DELC3-R-S  (Mr.  Donald  L.  Foiani) 
Fort  Monmouth,  NJ  07703 

Director 

US  Army  Electronics  Technology  4 
Devices  Laboratory 
ATTN;  DELET-DD  (S.  Danko) 

Fort  Monmouth,  NJ  07703 

Project  Manager 
FIREFINDER/REMBASS 

ATTN;  DRCPM-FFR-TM  (Mr.  John  M.  Bialb) 
Fort  Monmouth,  NJ  07703 


Conmander 

US  Army  Electronics  Research 
4  Development  Command 
ATTN:  DRDEL-SA  (Dr.  Walter  S.  McAfee) 
Fort  Monmouth,  NJ  07703 

OLA,  2WS  (MAC) 

Holloman  AFB,  NM  88330 
Commander 

Air  Force  Weapons  Laboratory 
ATTN;  AFWL/WE  (MW  John  R.  El  rick) 
Kirtland.  AFB,  NM  87117 

Director 

USA  TRADOC  Systems  Analysis  Activity 
ATTN:  ATAA-SL 

White  Sands  Missile  Range,  NM  88002 
Director 

USA  TRADOC  Systems  Analysis  Activity 
ATTN:  ATAA-SL  (Dolores  Anguiano) 

White  Sands  Missile  Range,  NM  88002 

Director 

USA  TRADOC  Systems  Analysis  Activity 
ATTN;  ATAA-TDB  (Mr.  Louie  Dominguez) 
White  Sands  Missile  Range,  NM  88002 

Director 

USA  TRADOC  Systems  Analysis  Activity 
ATTN;  ATAA-TDB  (Mr.  William  J.  Leach) 
White  Sands  Missile  Range,  NM  88002 

Director 

USA  TRADOC  Systems  Analysis  Activity 
ATTN:  ATAA-TGP  (Mr.  Roger  F.  Willis) 
White  Sands  Missile  Range,  NM  88002 

Director 

Office  of  Missile  Electronic  Warfare 
ATTN:  DELEW-M-STO  (Dr.  Steven  Kovel) 
White  Sands  Missile  Range,  NM  88002 

Office  of  the  Test  Director 
Joint  Services  EO  GW  CM  Test  Program 
ATTN:  DRXDE-TD  (Mr.  Weldon  Findley) 
White  Sands  Missile  Range,  NM  88002 

Commander 

US  Amy  White  Sands  Missile  Range 
ATTN:  STEWS-PT-AL  (Laurel  B.  Saunders) 
White  Sands  Missile  Range,  NM  88002 
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Commander 

US  Am^  RSD  Coordinator 
US  Embassy  -  Bonn 
Box  165 

APO  New  York  09080 

Grumman  Aerospace  Corporation 
Research  Department  -  MS  A08-35 
ATTN:  John  E.  A.  Selby 
Bethpage,  NY  11714 

Rome  Air  Development  Center 
ATTN:  Documents  Library 
TSLD  (Bette  Smith) 

Griff Iss  AFB,  NY  13441 

Dr.  Roberto  Vagllo-Laurin 
Faculty  of  Arts  and  Science 
Dept,  of  Applied  Science 
26-36  Stuyvesant  Street 
New  York.  NY  10003 

Air  Force  Wright  Aeronautical  Laboratories/ 
Avionics  Laboratory 

ATTN:  AFWAL/AARI-3  (Mr,  Harold  Geltmacher) 
Wright-Patterson  AFB,  OH  45433 

Air  Force  Wright  Aeronautical  Laboratories/ 
Avionics  Laboratory 

ATTN:  AFWAL/AARI-3  (CPT  William  C.  Smith) 
Wright-Patterson  AFB,  OH  45433 

Commandant 

JS  Army  Field  Artillery  School 
ATTN:  ATSF-CF-R  (CPT  James  M.  Watson) 

Fort  Sill,  OK  73503 

Commandant 

US  Army  Field  Artillery  School 
ATTN:  ATSF-CD-MS 
Fort  Sill,  OK  73503 

Commandant 

US  Army  Field  Artillery  School 
ATTN:  ATSF-CF-R 
Fort  Sill,  OK  73503 

Commandant 

US  Army  Field  Artillery  School 
ATTN:  NOAA  Liaison  Officer 

(CDR  Jeffrey  G.  Carlen) 

Fort  Sill,  OK  73503 


Commandant 

US  AnRy  Field  Artillery  School 
Morris  Swett  Library 
ATTN:  Reference  Librarian 
Fort  Sill,  OK  73503 

Conmander 

Naval  Air  Development  Center 
ATTN:  Code  301  (Mr.  George  F.  Eck) 
Warminster,  PA  18974 

The  Un1ve»*s1ty  of  Texas  at  El  Paso 
Electrical  Engineering  Department 
ATTN:  Or.  Joseph  H.  Plerlulssi 
El  Paso,  TX  79968 

Commandant 

US  Army  Air  Defense  School 

ATTN:  ATSA-CD-SC-A  (CPT  Charles  T.  Thorn) 

Fort  Bliss,  TX  79916 

Commander 

HQ,  TRADOC  Combined  Arms  Test  Activity 
ATTN:  ATCAT-OP-Q  (CPT  Henry  C.  Cobb,  Jr.) 
Fort  Hood,  TX  76544 

Commander 

HQ,  TRADOC  Combined  Arms  Test  Activity 
AHN:  ATCAT-SCI  (Dr.  Darrell  W.  Collier) 
Fort  Hood,  TX  76544 

Commander 

US  Army  Dugway  Proving  Ground 
ATTN:  STEDP-MT-DA-L 
Dugway,  UT  84022 

Commander 

US  Amy  Dugway  Proving  Ground 

ATTN:  STEDP-MT-DA-M  (Mr.  Paul  E.  Carlson) 

Dugway,  UT  84022 

Commander 

US  Amy  Dugway  Proving  Ground 

AHN:  STEDP-MT-DA-T  (Mr.  John  Trethewey) 

Dugway,  UT  84022 

Commander 

US  Amy  Dugway  Proving  Ground 

ATTN:  STEDP-MT-DA-T  (Mr.  William  Peterson) 

Dugway,  UT  84022 
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Defense  Documentation  Center 
ATTN:  OOC-TCA 
Cameron  Station  Bldg  5 
Alexandria,  VA  22314 
12 

Ballistic  Missile  Defense  Program  Office 
ATTN:  DACS-BMT  (Colonel  Harry  F.  Ennis) 
5001  Eisenhower  Avenue 
Alexandria,  VA  22333 

Defense  Technical  Information  Center 
ATTN:  DDA-2  (Mr.  James  E.  Shafer) 
Cameron  Station,  Bldq  5 
Alexandria,  VA  22314 

Commander 

US  Army  Materiel  Development 
4  Readiness  Command 

ATTN:  DRCBSI-EE  (Mr.  Albert  Giambalvo) 
5001  Eisenhower  Avenue 
Alexandria,  VA  22333 

Commander 

US  Army  Materiel  Development 
4  Readiness  Command 
ATTN:  DRCLDC  (Mr.  James  Bender) 

5001  Eisenhower  Avenue 
Alexandria,  VA  22333 

Defense  Advanced  Rsch  Projects  Agency 
ATTN:  Steve  Zakanyez 
1400  Wilson  131  vd 
Arlington,  VA  22209 

Defense  Advanced  Rsch  Projects  Agency 
ATTN:  Dr.  James  Tegnelia 
1400  Wilson  Blvd 
Arlington,  VA  22209 

Institute  for  Defense  Analyses 
ATTN:  Mr.  Lucien  M.  Biberman 
400  Army-Navy  Drive 
Arlington,  VA  22202 

Institute  for  Defense  Analyses 
ATTN:  Dr.  Ernest  Bauer 
400  Army-Navy  Drive 
Arlington,  VA  22202 

Institute  for  Defense  Analyses 
ATTN:  Dr.  Hans  G.  Wolf hard 
400  Amy-Navy  Drive 
Arlington,  VA  22202 


System  Planning  Corporation 
ATTN:  Mr.  Daniel  '^riedman 
1500  Wilson  Boulevard 
Arlington,  VA  22209 

System  Planning  Corporation 
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